stack-1.1.2/doc/0000755000000000000000000000000012717707440011564 5ustar0000000000000000stack-1.1.2/src/0000755000000000000000000000000012640371642011602 5ustar0000000000000000stack-1.1.2/src/Control/0000755000000000000000000000000012536131703013216 5ustar0000000000000000stack-1.1.2/src/Control/Concurrent/0000755000000000000000000000000012630674604015347 5ustar0000000000000000stack-1.1.2/src/Data/0000755000000000000000000000000012717707440012457 5ustar0000000000000000stack-1.1.2/src/Data/Aeson/0000755000000000000000000000000012717707440013524 5ustar0000000000000000stack-1.1.2/src/Data/Attoparsec/0000755000000000000000000000000012707670645014571 5ustar0000000000000000stack-1.1.2/src/Data/Binary/0000755000000000000000000000000012662071422013674 5ustar0000000000000000stack-1.1.2/src/Data/IORef/0000755000000000000000000000000012565175366013432 5ustar0000000000000000stack-1.1.2/src/Data/Maybe/0000755000000000000000000000000012630674604013513 5ustar0000000000000000stack-1.1.2/src/Data/Monoid/0000755000000000000000000000000012717707440013704 5ustar0000000000000000stack-1.1.2/src/Distribution/0000755000000000000000000000000012577400131014254 5ustar0000000000000000stack-1.1.2/src/Distribution/Version/0000755000000000000000000000000012613222640015677 5ustar0000000000000000stack-1.1.2/src/Network/0000755000000000000000000000000012531105532013223 5ustar0000000000000000stack-1.1.2/src/Network/HTTP/0000755000000000000000000000000012717707440014016 5ustar0000000000000000stack-1.1.2/src/Network/HTTP/Download/0000755000000000000000000000000012717707440015565 5ustar0000000000000000stack-1.1.2/src/Options/0000755000000000000000000000000012532675231013236 5ustar0000000000000000stack-1.1.2/src/Options/Applicative/0000755000000000000000000000000012706265473015505 5ustar0000000000000000stack-1.1.2/src/Options/Applicative/Builder/0000755000000000000000000000000012717707440017070 5ustar0000000000000000stack-1.1.2/src/Path/0000755000000000000000000000000012674023022012467 5ustar0000000000000000stack-1.1.2/src/Stack/0000755000000000000000000000000012717707447012662 5ustar0000000000000000stack-1.1.2/src/Stack/Build/0000755000000000000000000000000012717707440013712 5ustar0000000000000000stack-1.1.2/src/Stack/Config/0000755000000000000000000000000012717707440014060 5ustar0000000000000000stack-1.1.2/src/Stack/Docker/0000755000000000000000000000000012662071422014053 5ustar0000000000000000stack-1.1.2/src/Stack/Setup/0000755000000000000000000000000012717707441013754 5ustar0000000000000000stack-1.1.2/src/Stack/Sig/0000755000000000000000000000000012717707441013376 5ustar0000000000000000stack-1.1.2/src/Stack/Types/0000755000000000000000000000000012717707441013760 5ustar0000000000000000stack-1.1.2/src/Stack/Types/Config/0000755000000000000000000000000012717707441015165 5ustar0000000000000000stack-1.1.2/src/System/0000755000000000000000000000000012531105532013056 5ustar0000000000000000stack-1.1.2/src/System/Process/0000755000000000000000000000000012701273661014504 5ustar0000000000000000stack-1.1.2/src/main/0000755000000000000000000000000012717707441012533 5ustar0000000000000000stack-1.1.2/src/test/0000755000000000000000000000000012541037631012556 5ustar0000000000000000stack-1.1.2/src/test/Network/0000755000000000000000000000000012532106675014214 5ustar0000000000000000stack-1.1.2/src/test/Network/HTTP/0000755000000000000000000000000012532106675014773 5ustar0000000000000000stack-1.1.2/src/test/Network/HTTP/Download/0000755000000000000000000000000012717707441016545 5ustar0000000000000000stack-1.1.2/src/test/Stack/0000755000000000000000000000000012717707441013633 5ustar0000000000000000stack-1.1.2/src/test/Stack/Build/0000755000000000000000000000000012565175366014700 5ustar0000000000000000stack-1.1.2/test/0000755000000000000000000000000012541037631011767 5ustar0000000000000000stack-1.1.2/test/integration/0000755000000000000000000000000012711670713014315 5ustar0000000000000000stack-1.1.2/test/integration/lib/0000755000000000000000000000000012712355472015066 5ustar0000000000000000stack-1.1.2/test/package-dump/0000755000000000000000000000000012644245454014335 5ustar0000000000000000stack-1.1.2/src/Control/Concurrent/Execute.hs0000644000000000000000000001163612630674604017314 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-} -- Concurrent execution with dependencies. Types currently hard-coded for needs -- of stack, but could be generalized easily. module Control.Concurrent.Execute ( ActionType (..) , ActionId (..) , ActionContext (..) , Action (..) , runActions ) where import Control.Applicative import Control.Concurrent.Async (Concurrently (..), async) import Control.Concurrent.STM import Control.Exception import Control.Monad (join, unless) import Data.Foldable (sequenceA_) import Data.Set (Set) import qualified Data.Set as Set import Data.Typeable (Typeable) import Prelude -- Fix AMP warning import Stack.Types data ActionType = ATBuild | ATBuildFinal | ATFinal deriving (Show, Eq, Ord) data ActionId = ActionId !PackageIdentifier !ActionType deriving (Show, Eq, Ord) data Action = Action { actionId :: !ActionId , actionDeps :: !(Set ActionId) , actionDo :: !(ActionContext -> IO ()) } data ActionContext = ActionContext { acRemaining :: !(Set ActionId) -- ^ Does not include the current action } deriving Show data ExecuteState = ExecuteState { esActions :: TVar [Action] , esExceptions :: TVar [SomeException] , esInAction :: TVar (Set ActionId) , esCompleted :: TVar Int , esFinalLock :: Maybe (TMVar ()) , esKeepGoing :: Bool } data ExecuteException = InconsistentDependencies deriving Typeable instance Exception ExecuteException instance Show ExecuteException where show InconsistentDependencies = "Inconsistent dependencies were discovered while executing your build plan. This should never happen, please report it as a bug to the stack team." runActions :: Int -- ^ threads -> Bool -- ^ keep going after one task has failed -> Bool -- ^ run final actions concurrently? -> [Action] -> (TVar Int -> IO ()) -- ^ progress updated -> IO [SomeException] runActions threads keepGoing concurrentFinal actions0 withProgress = do es <- ExecuteState <$> newTVarIO actions0 <*> newTVarIO [] <*> newTVarIO Set.empty <*> newTVarIO 0 <*> (if concurrentFinal then pure Nothing else Just <$> atomically (newTMVar ())) <*> pure keepGoing _ <- async $ withProgress $ esCompleted es if threads <= 1 then runActions' es else runConcurrently $ sequenceA_ $ replicate threads $ Concurrently $ runActions' es readTVarIO $ esExceptions es runActions' :: ExecuteState -> IO () runActions' ExecuteState {..} = loop where breakOnErrs inner = do errs <- readTVar esExceptions if null errs || esKeepGoing then inner else return $ return () withActions inner = do as <- readTVar esActions if null as then return $ return () else inner as loop = join $ atomically $ breakOnErrs $ withActions $ \as -> case break (Set.null . actionDeps) as of (_, []) -> do inAction <- readTVar esInAction if Set.null inAction then do unless esKeepGoing $ modifyTVar esExceptions (toException InconsistentDependencies:) return $ return () else retry (xs, action:ys) -> do unlock <- case (actionId action, esFinalLock) of (ActionId _ ATFinal, Just lock) -> do takeTMVar lock return $ putTMVar lock () _ -> return $ return () let as' = xs ++ ys inAction <- readTVar esInAction let remaining = Set.union (Set.fromList $ map actionId as') inAction writeTVar esActions as' modifyTVar esInAction (Set.insert $ actionId action) return $ mask $ \restore -> do eres <- try $ restore $ actionDo action ActionContext { acRemaining = remaining } atomically $ do unlock modifyTVar esInAction (Set.delete $ actionId action) modifyTVar esCompleted (+1) case eres of Left err -> modifyTVar esExceptions (err:) Right () -> let dropDep a = a { actionDeps = Set.delete (actionId action) $ actionDeps a } in modifyTVar esActions $ map dropDep restore loop stack-1.1.2/src/Data/Aeson/Extended.hs0000644000000000000000000001306512717707440015625 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} -- | Extensions to Aeson parsing of objects. module Data.Aeson.Extended ( module Export -- * Extended failure messages , (.:) , (.:?) -- * JSON Parser that emits warnings , JSONWarning (..) , WarningParser , WithJSONWarnings (..) , withObjectWarnings , jsonSubWarnings , jsonSubWarningsT , jsonSubWarningsTT , logJSONWarnings , noJSONWarnings , tellJSONField , unWarningParser , (..:) , (..:?) , (..!=) ) where import Control.Monad.Logger (MonadLogger, logWarn) import Control.Monad.Trans (lift) import Control.Monad.Trans.Writer.Strict (WriterT, mapWriterT, runWriterT, tell) import Data.Aeson as Export hiding ((.:), (.:?)) import qualified Data.Aeson as A import Data.Aeson.Types hiding ((.:), (.:?)) import qualified Data.HashMap.Strict as HashMap import Data.Monoid import Data.Set (Set) import qualified Data.Set as Set import Data.Text (unpack, Text) import qualified Data.Text as T import Data.Traversable import qualified Data.Traversable as Traversable import GHC.Generics (Generic) import Generics.Deriving.Monoid (mappenddefault, memptydefault) import Prelude -- Fix redundant import warnings -- | Extends @.:@ warning to include field name. (.:) :: FromJSON a => Object -> Text -> Parser a (.:) o p = modifyFailure (("failed to parse field '" <> unpack p <> "': ") <>) (o A..: p) {-# INLINE (.:) #-} -- | Extends @.:?@ warning to include field name. (.:?) :: FromJSON a => Object -> Text -> Parser (Maybe a) (.:?) o p = modifyFailure (("failed to parse field '" <> unpack p <> "': ") <>) (o A..:? p) {-# INLINE (.:?) #-} -- | 'WarningParser' version of @.:@. (..:) :: FromJSON a => Object -> Text -> WarningParser a o ..: k = tellJSONField k >> lift (o .: k) -- | 'WarningParser' version of @.:?@. (..:?) :: FromJSON a => Object -> Text -> WarningParser (Maybe a) o ..:? k = tellJSONField k >> lift (o .:? k) -- | 'WarningParser' version of @.!=@. (..!=) :: WarningParser (Maybe a) -> a -> WarningParser a wp ..!= d = flip mapWriterT wp $ \p -> do a <- fmap snd p fmap (, a) (fmap fst p .!= d) -- | Tell warning parser about an expected field, so it doesn't warn about it. tellJSONField :: Text -> WarningParser () tellJSONField key = tell (mempty { wpmExpectedFields = Set.singleton key}) -- | 'WarningParser' version of 'withObject'. withObjectWarnings :: String -> (Object -> WarningParser a) -> Value -> Parser (WithJSONWarnings a) withObjectWarnings expected f = withObject expected $ \obj -> do (a,w) <- runWriterT (f obj) let unrecognizedFields = Set.toList (Set.difference (Set.fromList (HashMap.keys obj)) (wpmExpectedFields w)) return (WithJSONWarnings a (wpmWarnings w ++ case unrecognizedFields of [] -> [] _ -> [JSONUnrecognizedFields expected unrecognizedFields])) -- | Convert a 'WarningParser' to a 'Parser'. unWarningParser :: WarningParser a -> Parser a unWarningParser wp = do (a,_) <- runWriterT wp return a -- | Log JSON warnings. logJSONWarnings :: MonadLogger m => FilePath -> [JSONWarning] -> m () logJSONWarnings fp = mapM_ (\w -> $logWarn ("Warning: " <> T.pack fp <> ": " <> T.pack (show w))) -- | Handle warnings in a sub-object. jsonSubWarnings :: WarningParser (WithJSONWarnings a) -> WarningParser a jsonSubWarnings f = do WithJSONWarnings result warnings <- f tell (mempty { wpmWarnings = warnings }) return result -- | Handle warnings in a @Traversable@ of sub-objects. jsonSubWarningsT :: Traversable t => WarningParser (t (WithJSONWarnings a)) -> WarningParser (t a) jsonSubWarningsT f = Traversable.mapM (jsonSubWarnings . return) =<< f -- | Handle warnings in a @Maybe Traversable@ of sub-objects. jsonSubWarningsTT :: (Traversable t, Traversable u) => WarningParser (u (t (WithJSONWarnings a))) -> WarningParser (u (t a)) jsonSubWarningsTT f = Traversable.mapM (jsonSubWarningsT . return) =<< f -- Parsed JSON value without any warnings noJSONWarnings :: a -> WithJSONWarnings a noJSONWarnings v = WithJSONWarnings v [] -- | JSON parser that warns about unexpected fields in objects. type WarningParser a = WriterT WarningParserMonoid Parser a -- | Monoid used by 'WarningParser' to track expected fields and warnings. data WarningParserMonoid = WarningParserMonoid { wpmExpectedFields :: !(Set Text) , wpmWarnings :: [JSONWarning] } deriving Generic instance Monoid WarningParserMonoid where mempty = memptydefault mappend = mappenddefault -- Parsed JSON value with its warnings data WithJSONWarnings a = WithJSONWarnings a [JSONWarning] deriving Generic instance Functor WithJSONWarnings where fmap f (WithJSONWarnings x w) = WithJSONWarnings (f x) w instance Monoid a => Monoid (WithJSONWarnings a) where mempty = memptydefault mappend = mappenddefault -- | Warning output from 'WarningParser'. data JSONWarning = JSONUnrecognizedFields String [Text] instance Show JSONWarning where show (JSONUnrecognizedFields obj [field]) = "Unrecognized field in " <> obj <> ": " <> T.unpack field show (JSONUnrecognizedFields obj fields) = "Unrecognized fields in " <> obj <> ": " <> T.unpack (T.intercalate ", " fields) stack-1.1.2/src/Data/Attoparsec/Args.hs0000644000000000000000000000235712644245454016024 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Parsing of stack command line arguments module Data.Attoparsec.Args ( EscapingMode(..) , argsParser , parseArgs ) where import Control.Applicative import Data.Attoparsec.Text (()) import qualified Data.Attoparsec.Text as P import Data.Text (Text) -- | Mode for parsing escape characters. data EscapingMode = Escaping | NoEscaping deriving (Show,Eq,Enum) -- | Parse arguments using 'argsParser'. parseArgs :: EscapingMode -> Text -> Either String [String] parseArgs mode = P.parseOnly (argsParser mode) -- | A basic argument parser. It supports space-separated text, and -- string quotation with identity escaping: \x -> x. argsParser :: EscapingMode -> P.Parser [String] argsParser mode = many (P.skipSpace *> (quoted <|> unquoted)) <* P.skipSpace <* (P.endOfInput "unterminated string") where unquoted = P.many1 naked quoted = P.char '"' *> string <* P.char '"' string = many (case mode of Escaping -> escaped <|> nonquote NoEscaping -> nonquote) escaped = P.char '\\' *> P.anyChar nonquote = P.satisfy (/= '"') naked = P.satisfy (not . flip elem ("\" " :: String)) stack-1.1.2/src/Data/Attoparsec/Combinators.hs0000644000000000000000000000114612531105532017366 0ustar0000000000000000-- | More readable combinators for writing parsers. module Data.Attoparsec.Combinators where import Control.Applicative import Data.Monoid -- | Concatenate two parsers. appending :: (Applicative f,Monoid a) => f a -> f a -> f a appending a b = (<>) <$> a <*> b -- | Alternative parsers. alternating :: Alternative f => f a -> f a -> f a alternating a b = a <|> b -- | Pure something. pured :: (Applicative g,Applicative f) => g a -> g (f a) pured = fmap pure -- | Concatting the result of an action. concating :: (Monoid m,Applicative f) => f [m] -> f m concating = fmap mconcat stack-1.1.2/src/Data/Attoparsec/Interpreter.hs0000644000000000000000000001351412707670645017434 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | This module implements parsing of additional arguments embedded in a comment when stack is invoked as a script interpreter ===Specifying arguments in script interpreter mode @/stack/@ can execute a Haskell source file using @/runghc/@ and if required it can also install and setup the compiler and any package dependencies automatically. For using a Haskell source file as an executable script on a Unix like OS, the first line of the file must specify @stack@ as the interpreter using a shebang directive e.g. > #!/usr/bin/env stack Additional arguments can be specified in a haskell comment following the @#!@ line. The contents inside the comment must be a single valid stack command line, starting with @stack@ as the command and followed by the options to use for executing this file. The comment must be on the line immediately following the @#!@ line. The comment must start in the first column of the line. When using a block style comment the command can be split on multiple lines. Here is an example of a single line comment: > #!/usr/bin/env stack > -- stack --resolver lts-3.14 --install-ghc runghc --package random Here is an example of a multi line block comment: @ #!\/usr\/bin\/env stack {\- stack --resolver lts-3.14 --install-ghc runghc --package random -\} @ When the @#!@ line is not present, the file can still be executed using @stack \@ command if the file starts with a valid stack interpreter comment. This can be used to execute the file on Windows for example. Nested block comments are not supported. -} module Data.Attoparsec.Interpreter ( interpreterArgsParser -- for unit tests , getInterpreterArgs ) where import Control.Applicative import Data.Attoparsec.Args import Data.Attoparsec.Text (()) import qualified Data.Attoparsec.Text as P import Data.Char (isSpace) import Data.Conduit import Data.Conduit.Attoparsec import qualified Data.Conduit.Binary as CB import Data.Conduit.Text (decodeUtf8) import Data.List (intercalate) import Data.Text (pack) import Stack.Constants import System.FilePath (takeExtension) import System.IO (IOMode (ReadMode), withBinaryFile, stderr, hPutStrLn) -- | Parser to extract the stack command line embedded inside a comment -- after validating the placement and formatting rules for a valid -- interpreter specification. interpreterArgsParser :: Bool -> String -> P.Parser String interpreterArgsParser isLiterate progName = P.option "" sheBangLine *> interpreterComment where sheBangLine = P.string "#!" *> P.manyTill P.anyChar P.endOfLine commentStart psr = (psr (progName ++ " options comment")) *> P.skipSpace *> (P.string (pack progName) show progName) -- Treat newlines as spaces inside the block comment anyCharNormalizeSpace = let normalizeSpace c = if isSpace c then ' ' else c in P.satisfyWith normalizeSpace $ const True comment start end = commentStart start *> ((end >> return "") <|> (P.space *> (P.manyTill anyCharNormalizeSpace end "-}"))) horizontalSpace = P.satisfy P.isHorizontalSpace lineComment = comment "--" (P.endOfLine <|> P.endOfInput) literateLineComment = comment (">" *> horizontalSpace *> "--") (P.endOfLine <|> P.endOfInput) blockComment = comment "{-" (P.string "-}") literateBlockComment = (">" *> horizontalSpace *> "{-") *> P.skipMany (("" <$ horizontalSpace) <|> (P.endOfLine *> ">")) *> (P.string (pack progName) progName) *> (P.manyTill' (P.satisfy (not . P.isEndOfLine) <|> (' ' <$ (P.endOfLine *> ">" ">"))) "-}") interpreterComment = if isLiterate then literateLineComment <|> literateBlockComment else lineComment <|> blockComment -- | Extract stack arguments from a correctly placed and correctly formatted -- comment when it is being used as an interpreter getInterpreterArgs :: String -> IO [String] getInterpreterArgs file = do eArgStr <- withBinaryFile file ReadMode parseFile case eArgStr of Left err -> handleFailure $ decodeError err Right str -> parseArgStr str where parseFile h = CB.sourceHandle h =$= decodeUtf8 $$ sinkParserEither (interpreterArgsParser isLiterate stackProgName) isLiterate = takeExtension file == ".lhs" -- FIXME We should print anything only when explicit verbose mode is -- specified by the user on command line. But currently the -- implementation does not accept or parse any command line flags in -- interpreter mode. We can only invoke the interpreter as -- "stack " strictly without any options. stackWarn s = hPutStrLn stderr $ stackProgName ++ ": WARNING! " ++ s handleFailure err = do mapM_ stackWarn (lines err) stackWarn "Missing or unusable stack options specification" stackWarn "Using runghc without any additional stack options" return ["runghc"] parseArgStr str = case P.parseOnly (argsParser Escaping) (pack str) of Left err -> handleFailure ("Error parsing command specified in the \ \stack options comment: " ++ err) Right [] -> handleFailure ("Empty argument list in stack options \ \comment") Right args -> return args decodeError e = case e of ParseError ctxs _ (Position line col) -> if length ctxs == 0 then "Parse error" else ("Expecting " ++ (intercalate " or " ctxs)) ++ " at line " ++ (show line) ++ ", column " ++ (show col) DivergentParser -> "Divergent parser" stack-1.1.2/src/Data/Binary/VersionTagged.hs0000644000000000000000000000604412662071422016775 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ConstraintKinds #-} -- | Tag a Binary instance with the stack version number to ensure we're -- reading a compatible format. module Data.Binary.VersionTagged ( taggedDecodeOrLoad , taggedEncodeFile , Binary (..) , BinarySchema , HasStructuralInfo , HasSemanticVersion , decodeFileOrFailDeep , NFData (..) ) where import Control.DeepSeq (NFData (..)) import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow (..)) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Logger import Data.Binary (Binary (..)) import Data.Binary.Get (ByteOffset) import Data.Binary.Tagged (HasStructuralInfo, HasSemanticVersion) import qualified Data.Binary.Tagged as BinaryTagged import Data.Monoid ((<>)) import Data.Typeable (Typeable) import Control.Exception.Enclosed (tryAnyDeep) import Path import Path.IO (ensureDir) import qualified Data.Text as T type BinarySchema a = (Binary a, NFData a, HasStructuralInfo a, HasSemanticVersion a) -- | Write to the given file, with a binary-tagged tag. taggedEncodeFile :: (BinarySchema a, MonadIO m) => Path Abs File -> a -> m () taggedEncodeFile fp x = liftIO $ do ensureDir (parent fp) BinaryTagged.taggedEncodeFile (toFilePath fp) x -- | Read from the given file. If the read fails, run the given action and -- write that back to the file. Always starts the file off with the version -- tag. taggedDecodeOrLoad :: (BinarySchema a, MonadIO m, MonadLogger m) => Path Abs File -> m a -> m a taggedDecodeOrLoad fp mx = do let fpt = T.pack (toFilePath fp) $logDebug $ "Trying to decode " <> fpt eres <- decodeFileOrFailDeep fp case eres of Left _ -> do $logDebug $ "Failure decoding " <> fpt x <- mx taggedEncodeFile fp x return x Right x -> do $logDebug $ "Success decoding " <> fpt return x -- | Ensure that there are no lurking exceptions deep inside the parsed -- value... because that happens unfortunately. See -- https://github.com/commercialhaskell/stack/issues/554 decodeFileOrFailDeep :: (BinarySchema a, MonadIO m, MonadThrow n) => Path loc File -> m (n a) decodeFileOrFailDeep fp = liftIO $ fmap (either throwM return) $ tryAnyDeep $ do eres <- BinaryTagged.taggedDecodeFileOrFail (toFilePath fp) case eres of Left (offset, str) -> throwM $ DecodeFileFailure (toFilePath fp) offset str Right x -> return x data DecodeFileFailure = DecodeFileFailure FilePath ByteOffset String deriving Typeable instance Show DecodeFileFailure where show (DecodeFileFailure fp offset str) = concat [ "Decoding of " , fp , " failed at offset " , show offset , ": " , str ] instance Exception DecodeFileFailure stack-1.1.2/src/Data/IORef/RunOnce.hs0000644000000000000000000000064712565175366015346 0ustar0000000000000000module Data.IORef.RunOnce (runOnce) where import Control.Monad.IO.Class import Data.IORef runOnce :: MonadIO m => m a -> m (m a) runOnce f = do ref <- liftIO $ newIORef Nothing return $ do mval <- liftIO $ readIORef ref case mval of Just val -> return val Nothing -> do val <- f liftIO $ writeIORef ref (Just val) return val stack-1.1.2/src/Data/Maybe/Extra.hs0000644000000000000000000000134712630674604015137 0ustar0000000000000000-- | Extra Maybe utilities. module Data.Maybe.Extra where import Control.Applicative import Control.Monad import Data.Traversable hiding (mapM) import Data.Maybe import Prelude -- Silence redundant import warnings -- | Applicative 'mapMaybe'. mapMaybeA :: Applicative f => (a -> f (Maybe b)) -> [a] -> f [b] mapMaybeA f = fmap catMaybes . traverse f -- | @'forMaybeA' '==' 'flip' 'mapMaybeA'@ forMaybeA :: Applicative f => [a] -> (a -> f (Maybe b)) -> f [b] forMaybeA = flip mapMaybeA -- | Monadic 'mapMaybe'. mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b] mapMaybeM f = liftM catMaybes . mapM f -- | @'forMaybeM' '==' 'flip' 'mapMaybeM'@ forMaybeM :: Monad m => [a] -> (a -> m (Maybe b)) -> m [b] forMaybeM = flip mapMaybeM stack-1.1.2/src/Data/Monoid/Extra.hs0000644000000000000000000000032712717707440015325 0ustar0000000000000000-- | Extra Monoid utilities. module Data.Monoid.Extra ( fromFirst , module Data.Monoid ) where import Data.Maybe import Data.Monoid fromFirst :: a -> First a -> a fromFirst x = fromMaybe x . getFirst stack-1.1.2/src/Distribution/Version/Extra.hs0000644000000000000000000000210512613222640017314 0ustar0000000000000000-- A separate module so that we can contain all usage of deprecated identifiers here {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module Distribution.Version.Extra ( hasUpper , hasLower ) where import Distribution.Version (VersionRange (..)) -- | Does the version range have an upper bound? hasUpper :: VersionRange -> Bool hasUpper AnyVersion = False hasUpper (ThisVersion _) = True hasUpper (LaterVersion _) = False hasUpper (EarlierVersion _) = True hasUpper (WildcardVersion _) = True hasUpper (UnionVersionRanges x y) = hasUpper x && hasUpper y hasUpper (IntersectVersionRanges x y) = hasUpper x || hasUpper y hasUpper (VersionRangeParens x) = hasUpper x -- | Does the version range have a lower bound? hasLower :: VersionRange -> Bool hasLower AnyVersion = False hasLower (ThisVersion _) = True hasLower (LaterVersion _) = True hasLower (EarlierVersion _) = False hasLower (WildcardVersion _) = True hasLower (UnionVersionRanges x y) = hasLower x && hasLower y hasLower (IntersectVersionRanges x y) = hasLower x || hasLower y hasLower (VersionRangeParens x) = hasLower x stack-1.1.2/src/Network/HTTP/Download.hs0000644000000000000000000001564412717707440016133 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Network.HTTP.Download ( verifiedDownload , DownloadRequest(..) , drRetryPolicyDefault , HashCheck(..) , DownloadException(..) , CheckHexDigest(..) , LengthCheck , VerifiedDownloadException(..) , download , redownload , downloadJSON , parseUrl , liftHTTP , ask , getHttpManager , MonadReader , HasHttpManager ) where import Control.Exception (Exception) import Control.Exception.Enclosed (handleIO) import Control.Monad (void) import Control.Monad.Catch (MonadMask, throwM) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Logger (MonadLogger, logDebug) import Control.Monad.Reader (MonadReader, ReaderT, ask, runReaderT) import Data.Aeson.Extended (FromJSON, parseJSON) import Data.Aeson.Parser (json') import Data.Aeson.Types (parseEither) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.Conduit (($$)) import Data.Conduit.Attoparsec (sinkParser) import Data.Conduit.Binary (sinkHandle, sourceHandle) import qualified Data.Conduit.Binary as CB import Data.Foldable (forM_) import Data.Monoid ((<>)) import Data.Text.Encoding.Error (lenientDecode) import Data.Text.Encoding (decodeUtf8With) import Data.Typeable (Typeable) import Network.HTTP.Client (path) import Network.HTTP.Client.Conduit (HasHttpManager, Manager, Request, Response, checkStatus, getHttpManager, parseUrl, requestHeaders, responseBody, responseHeaders, responseStatus, withResponse) import Network.HTTP.Download.Verified import Network.HTTP.Types (status200, status304) import Path (Abs, File, Path, toFilePath) import System.Directory (createDirectoryIfMissing, removeFile, renameFile) import System.FilePath (takeDirectory, (<.>)) import System.IO (IOMode (ReadMode), IOMode (WriteMode), withBinaryFile) -- | Download the given URL to the given location. If the file already exists, -- no download is performed. Otherwise, creates the parent directory, downloads -- to a temporary file, and on file download completion moves to the -- appropriate destination. -- -- Throws an exception if things go wrong download :: (MonadReader env m, HasHttpManager env, MonadIO m, MonadLogger m) => Request -> Path Abs File -- ^ destination -> m Bool -- ^ Was a downloaded performed (True) or did the file already exist (False)? download req destpath = do let downloadReq = DownloadRequest { drRequest = req , drHashChecks = [] , drLengthCheck = Nothing , drRetryPolicy = drRetryPolicyDefault } let progressHook _ = return () verifiedDownload downloadReq destpath progressHook -- | Same as 'download', but will download a file a second time if it is already present. -- -- Returns 'True' if the file was downloaded, 'False' otherwise redownload :: (MonadReader env m, HasHttpManager env, MonadIO m, MonadLogger m) => Request -> Path Abs File -- ^ destination -> m Bool redownload req0 dest = do $logDebug $ "Downloading " <> decodeUtf8With lenientDecode (path req0) let destFilePath = toFilePath dest etagFilePath = destFilePath <.> "etag" metag <- liftIO $ handleIO (const $ return Nothing) $ fmap Just $ withBinaryFile etagFilePath ReadMode $ \h -> sourceHandle h $$ CB.take 512 let req1 = case metag of Nothing -> req0 Just etag -> req0 { requestHeaders = requestHeaders req0 ++ [("If-None-Match", L.toStrict etag)] } req2 = req1 { checkStatus = \_ _ _ -> Nothing } env <- ask liftIO $ recoveringHttp drRetryPolicyDefault $ flip runReaderT env $ withResponse req2 $ \res -> case () of () | responseStatus res == status200 -> liftIO $ do createDirectoryIfMissing True $ takeDirectory destFilePath -- Order here is important: first delete the etag, then write the -- file, then write the etag. That way, if any step fails, it will -- force the download to happen again. handleIO (const $ return ()) $ removeFile etagFilePath let destFilePathTmp = destFilePath <.> "tmp" withBinaryFile destFilePathTmp WriteMode $ \h -> responseBody res $$ sinkHandle h renameFile destFilePathTmp destFilePath forM_ (lookup "ETag" (responseHeaders res)) $ \e -> do let tmp = etagFilePath <.> "tmp" S.writeFile tmp e renameFile tmp etagFilePath return True | responseStatus res == status304 -> return False | otherwise -> throwM $ RedownloadFailed req2 dest $ void res -- | Download a JSON value and parse it using a 'FromJSON' instance. downloadJSON :: (FromJSON a, MonadReader env m, HasHttpManager env, MonadIO m, MonadMask m) => Request -> m a downloadJSON req = do val <- recoveringHttp drRetryPolicyDefault $ liftHTTP $ withResponse req $ \res -> responseBody res $$ sinkParser json' case parseEither parseJSON val of Left e -> throwM $ DownloadJSONException req e Right x -> return x data DownloadException = DownloadJSONException Request String | RedownloadFailed Request (Path Abs File) (Response ()) deriving (Show, Typeable) instance Exception DownloadException -- | A convenience method for asking for the environment and then running an -- action with its 'Manager'. Useful for avoiding a 'MonadBaseControl' -- constraint. liftHTTP :: (MonadIO m, MonadReader env m, HasHttpManager env) => ReaderT Manager IO a -> m a liftHTTP inner = do env <- ask liftIO $ runReaderT inner $ getHttpManager env stack-1.1.2/src/Network/HTTP/Download/Verified.hs0000644000000000000000000002751312717707440017666 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} module Network.HTTP.Download.Verified ( verifiedDownload , recoveringHttp , DownloadRequest(..) , drRetryPolicyDefault , HashCheck(..) , CheckHexDigest(..) , LengthCheck , VerifiedDownloadException(..) ) where import qualified Data.List as List import qualified Data.ByteString as ByteString import qualified Data.ByteString.Base64 as B64 import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Control.Applicative import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger (logDebug, MonadLogger) import Control.Monad.Reader import Control.Retry (recovering,limitRetries,RetryPolicy,constantDelay) import "cryptohash" Crypto.Hash import Crypto.Hash.Conduit (sinkHash) import Data.ByteString (ByteString) import Data.ByteString.Char8 (readInteger) import Data.Conduit import Data.Conduit.Binary (sourceHandle, sinkHandle) import Data.Foldable (traverse_,for_) import Data.Monoid import Data.String import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Data.Typeable (Typeable) import GHC.IO.Exception (IOException(..),IOErrorType(..)) import Network.HTTP.Client.Conduit import Network.HTTP.Types.Header (hContentLength, hContentMD5) import Path import Prelude -- Fix AMP warning import System.Directory import System.FilePath ((<.>)) import System.IO -- | A request together with some checks to perform. data DownloadRequest = DownloadRequest { drRequest :: Request , drHashChecks :: [HashCheck] , drLengthCheck :: Maybe LengthCheck , drRetryPolicy :: RetryPolicy } -- | Default to retrying thrice with a short constant delay. drRetryPolicyDefault :: RetryPolicy drRetryPolicyDefault = limitRetries 3 <> constantDelay onehundredMilliseconds where onehundredMilliseconds = 100000 data HashCheck = forall a. (Show a, HashAlgorithm a) => HashCheck { hashCheckAlgorithm :: a , hashCheckHexDigest :: CheckHexDigest } deriving instance Show HashCheck data CheckHexDigest = CheckHexDigestString String | CheckHexDigestByteString ByteString | CheckHexDigestHeader ByteString deriving Show instance IsString CheckHexDigest where fromString = CheckHexDigestString type LengthCheck = Int -- | An exception regarding verification of a download. data VerifiedDownloadException = WrongContentLength Request Int -- expected ByteString -- actual (as listed in the header) | WrongStreamLength Request Int -- expected Int -- actual | WrongDigest Request String -- algorithm CheckHexDigest -- expected String -- actual (shown) deriving (Typeable) instance Show VerifiedDownloadException where show (WrongContentLength req expected actual) = "Download expectation failure: ContentLength header\n" ++ "Expected: " ++ show expected ++ "\n" ++ "Actual: " ++ displayByteString actual ++ "\n" ++ "For: " ++ show (getUri req) show (WrongStreamLength req expected actual) = "Download expectation failure: download size\n" ++ "Expected: " ++ show expected ++ "\n" ++ "Actual: " ++ show actual ++ "\n" ++ "For: " ++ show (getUri req) show (WrongDigest req algo expected actual) = "Download expectation failure: content hash (" ++ algo ++ ")\n" ++ "Expected: " ++ displayCheckHexDigest expected ++ "\n" ++ "Actual: " ++ actual ++ "\n" ++ "For: " ++ show (getUri req) instance Exception VerifiedDownloadException -- This exception is always caught and never thrown outside of this module. data VerifyFileException = WrongFileSize Int -- expected Integer -- actual (as listed by hFileSize) deriving (Show, Typeable) instance Exception VerifyFileException -- Show a ByteString that is known to be UTF8 encoded. displayByteString :: ByteString -> String displayByteString = Text.unpack . Text.strip . Text.decodeUtf8 -- Show a CheckHexDigest in human-readable format. displayCheckHexDigest :: CheckHexDigest -> String displayCheckHexDigest (CheckHexDigestString s) = s ++ " (String)" displayCheckHexDigest (CheckHexDigestByteString s) = displayByteString s ++ " (ByteString)" displayCheckHexDigest (CheckHexDigestHeader h) = displayByteString (B64.decodeLenient h) ++ " (Header. unencoded: " ++ displayByteString h ++ ")" -- | Make sure that the hash digest for a finite stream of bytes -- is as expected. -- -- Throws WrongDigest (VerifiedDownloadException) sinkCheckHash :: MonadThrow m => Request -> HashCheck -> Consumer ByteString m () sinkCheckHash req HashCheck{..} = do digest <- sinkHashUsing hashCheckAlgorithm let actualDigestString = show digest let actualDigestHexByteString = digestToHexByteString digest let passedCheck = case hashCheckHexDigest of CheckHexDigestString s -> s == actualDigestString CheckHexDigestByteString b -> b == actualDigestHexByteString CheckHexDigestHeader b -> B64.decodeLenient b == actualDigestHexByteString -- A hack to allow hackage tarballs to download. -- They should really base64-encode their md5 header as per rfc2616#sec14.15. -- https://github.com/commercialhaskell/stack/issues/240 || b == actualDigestHexByteString unless passedCheck $ throwM $ WrongDigest req (show hashCheckAlgorithm) hashCheckHexDigest actualDigestString assertLengthSink :: MonadThrow m => Request -> LengthCheck -> ZipSink ByteString m () assertLengthSink req expectedStreamLength = ZipSink $ do Sum actualStreamLength <- CL.foldMap (Sum . ByteString.length) when (actualStreamLength /= expectedStreamLength) $ throwM $ WrongStreamLength req expectedStreamLength actualStreamLength -- | A more explicitly type-guided sinkHash. sinkHashUsing :: (Monad m, HashAlgorithm a) => a -> Consumer ByteString m (Digest a) sinkHashUsing _ = sinkHash -- | Turns a list of hash checks into a ZipSink that checks all of them. hashChecksToZipSink :: MonadThrow m => Request -> [HashCheck] -> ZipSink ByteString m () hashChecksToZipSink req = traverse_ (ZipSink . sinkCheckHash req) -- 'Control.Retry.recovering' customized for HTTP failures recoveringHttp :: (MonadMask m, MonadIO m) => RetryPolicy -> m a -> m a recoveringHttp retryPolicy = #if MIN_VERSION_retry(0,7,0) recovering retryPolicy handlers . const #else recovering retryPolicy handlers #endif where handlers = [const $ Handler alwaysRetryHttp,const $ Handler retrySomeIO] alwaysRetryHttp :: Monad m => HttpException -> m Bool alwaysRetryHttp _ = return True retrySomeIO :: Monad m => IOException -> m Bool retrySomeIO e = return $ case ioe_type e of -- hGetBuf: resource vanished (Connection reset by peer) ResourceVanished -> True -- conservatively exclude all others _ -> False -- | Copied and extended version of Network.HTTP.Download.download. -- -- Has the following additional features: -- * Verifies that response content-length header (if present) -- matches expected length -- * Limits the download to (close to) the expected # of bytes -- * Verifies that the expected # bytes were downloaded (not too few) -- * Verifies md5 if response includes content-md5 header -- * Verifies the expected hashes -- -- Throws VerifiedDownloadException. -- Throws IOExceptions related to file system operations. -- Throws HttpException. verifiedDownload :: (MonadReader env m, HasHttpManager env, MonadIO m, MonadLogger m) => DownloadRequest -> Path Abs File -- ^ destination -> (Maybe Integer -> Sink ByteString (ReaderT env IO) ()) -- ^ custom hook to observe progress -> m Bool -- ^ Whether a download was performed verifiedDownload DownloadRequest{..} destpath progressSink = do let req = drRequest env <- ask whenM' (liftIO getShouldDownload) $ do $logDebug $ "Downloading " <> decodeUtf8With lenientDecode (path req) liftIO $ do createDirectoryIfMissing True dir withBinaryFile fptmp WriteMode $ \h -> recoveringHttp drRetryPolicy $ flip runReaderT env $ withResponse req (go h) renameFile fptmp fp where whenM' mp m = do p <- mp if p then m >> return True else return False fp = toFilePath destpath fptmp = fp <.> "tmp" dir = toFilePath $ parent destpath getShouldDownload = do fileExists <- doesFileExist fp if fileExists -- only download if file does not match expectations then not <$> fileMatchesExpectations -- or if it doesn't exist yet else return True -- precondition: file exists -- TODO: add logging fileMatchesExpectations = ((checkExpectations >> return True) `catch` \(_ :: VerifyFileException) -> return False) `catch` \(_ :: VerifiedDownloadException) -> return False checkExpectations = bracket (openFile fp ReadMode) hClose $ \h -> do for_ drLengthCheck $ checkFileSizeExpectations h sourceHandle h $$ getZipSink (hashChecksToZipSink drRequest drHashChecks) -- doesn't move the handle checkFileSizeExpectations h expectedFileSize = do fileSizeInteger <- hFileSize h when (fileSizeInteger > toInteger (maxBound :: Int)) $ throwM $ WrongFileSize expectedFileSize fileSizeInteger let fileSize = fromInteger fileSizeInteger when (fileSize /= expectedFileSize) $ throwM $ WrongFileSize expectedFileSize fileSizeInteger checkContentLengthHeader headers expectedContentLength = case List.lookup hContentLength headers of Just lengthBS -> do let lengthStr = displayByteString lengthBS when (lengthStr /= show expectedContentLength) $ throwM $ WrongContentLength drRequest expectedContentLength lengthBS _ -> return () go h res = do let headers = responseHeaders res mcontentLength = do hLength <- List.lookup hContentLength headers (i,_) <- readInteger hLength return i for_ drLengthCheck $ checkContentLengthHeader headers let hashChecks = (case List.lookup hContentMD5 headers of Just md5BS -> [ HashCheck { hashCheckAlgorithm = MD5 , hashCheckHexDigest = CheckHexDigestHeader md5BS } ] Nothing -> [] ) ++ drHashChecks responseBody res $= maybe (awaitForever yield) CB.isolate drLengthCheck $$ getZipSink ( hashChecksToZipSink drRequest hashChecks *> maybe (pure ()) (assertLengthSink drRequest) drLengthCheck *> ZipSink (sinkHandle h) *> ZipSink (progressSink mcontentLength)) stack-1.1.2/src/Options/Applicative/Args.hs0000644000000000000000000000276712562412670016742 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Accepting arguments to be passed through to a sub-process. module Options.Applicative.Args (argsArgument ,argsOption ,cmdOption ,parseArgsFromString) where import Data.Attoparsec.Args import qualified Data.Attoparsec.Text as P import qualified Data.Text as T import qualified Options.Applicative as O -- | An argument which accepts a list of arguments e.g. @--ghc-options="-X P.hs \"this\""@. argsArgument :: O.Mod O.ArgumentFields [String] -> O.Parser [String] argsArgument = O.argument (do string <- O.str either O.readerError return (parseArgsFromString string)) -- | An option which accepts a list of arguments e.g. @--ghc-options="-X P.hs \"this\""@. argsOption :: O.Mod O.OptionFields [String] -> O.Parser [String] argsOption = O.option (do string <- O.str either O.readerError return (parseArgsFromString string)) -- | An option which accepts a command and a list of arguments e.g. @--exec "echo hello world"@ cmdOption :: O.Mod O.OptionFields (String, [String]) -> O.Parser (String, [String]) cmdOption = O.option (do string <- O.str xs <- either O.readerError return (parseArgsFromString string) case xs of [] -> O.readerError "Must provide a command" x:xs' -> return (x, xs')) -- | Parse from a string. parseArgsFromString :: String -> Either String [String] parseArgsFromString = P.parseOnly (argsParser Escaping) . T.pack stack-1.1.2/src/Options/Applicative/Builder/Extra.hs0000644000000000000000000001313412717707440020511 0ustar0000000000000000-- | Extra functions for optparse-applicative. module Options.Applicative.Builder.Extra (boolFlags ,boolFlagsNoDefault ,maybeBoolFlags ,firstBoolFlags ,enableDisableFlags ,enableDisableFlagsNoDefault ,extraHelpOption ,execExtraHelp ,textOption ,textArgument ,optionalFirst ) where import Control.Monad (when) import Data.Monoid import Options.Applicative import Options.Applicative.Types (readerAsk) import System.Environment (withArgs) import System.FilePath (takeBaseName) import Data.Text (Text) import qualified Data.Text as T -- | Enable/disable flags for a 'Bool'. boolFlags :: Bool -- ^ Default value -> String -- ^ Flag name -> String -- ^ Help suffix -> Mod FlagFields Bool -> Parser Bool boolFlags defaultValue = enableDisableFlags defaultValue True False -- | Enable/disable flags for a 'Bool', without a default case (to allow chaining with '<|>'). boolFlagsNoDefault :: String -- ^ Flag name -> String -- ^ Help suffix -> Mod FlagFields Bool -> Parser Bool boolFlagsNoDefault = enableDisableFlagsNoDefault True False -- | Enable/disable flags for a @('Maybe' 'Bool')@. maybeBoolFlags :: String -- ^ Flag name -> String -- ^ Help suffix -> Mod FlagFields (Maybe Bool) -> Parser (Maybe Bool) maybeBoolFlags = enableDisableFlags Nothing (Just True) (Just False) -- | Like 'maybeBoolFlags', but parsing a 'First'. firstBoolFlags :: String -> String -> Mod FlagFields (Maybe Bool) -> Parser (First Bool) firstBoolFlags long0 help0 mod0 = First <$> maybeBoolFlags long0 help0 mod0 -- | Enable/disable flags for any type. enableDisableFlags :: a -- ^ Default value -> a -- ^ Enabled value -> a -- ^ Disabled value -> String -- ^ Name -> String -- ^ Help suffix -> Mod FlagFields a -> Parser a enableDisableFlags defaultValue enabledValue disabledValue name helpSuffix mods = enableDisableFlagsNoDefault enabledValue disabledValue name helpSuffix mods <|> pure defaultValue -- | Enable/disable flags for any type, without a default (to allow chaining with '<|>') enableDisableFlagsNoDefault :: a -- ^ Enabled value -> a -- ^ Disabled value -> String -- ^ Name -> String -- ^ Help suffix -> Mod FlagFields a -> Parser a enableDisableFlagsNoDefault enabledValue disabledValue name helpSuffix mods = last <$> some ((flag' enabledValue (hidden <> internal <> long name <> help helpSuffix <> mods) <|> flag' disabledValue (hidden <> internal <> long ("no-" ++ name) <> help helpSuffix <> mods)) <|> flag' disabledValue (long (concat ["[no-]", name]) <> help (concat ["Enable/disable ", helpSuffix]) <> mods)) -- | Show an extra help option (e.g. @--docker-help@ shows help for all @--docker*@ args). -- -- To actually have that help appear, use 'execExtraHelp' before executing the main parser. extraHelpOption :: Bool -- ^ Hide from the brief description? -> String -- ^ Program name, e.g. @"stack"@ -> String -- ^ Option glob expression, e.g. @"docker*"@ -> String -- ^ Help option name, e.g. @"docker-help"@ -> Parser (a -> a) extraHelpOption hide progName fakeName helpName = infoOption (optDesc' ++ ".") (long helpName <> hidden <> internal) <*> infoOption (optDesc' ++ ".") (long fakeName <> help optDesc' <> (if hide then hidden <> internal else idm)) where optDesc' = concat ["Run '", takeBaseName progName, " --", helpName, "' for details"] -- | Display extra help if extra help option passed in arguments. -- -- Since optparse-applicative doesn't allow an arbitrary IO action for an 'abortOption', this -- was the best way I found that doesn't require manually formatting the help. execExtraHelp :: [String] -- ^ Command line arguments -> String -- ^ Extra help option name, e.g. @"docker-help"@ -> Parser a -- ^ Option parser for the relevant command -> String -- ^ Option description -> IO () execExtraHelp args helpOpt parser pd = when (args == ["--" ++ helpOpt]) $ withArgs ["--help"] $ do _ <- execParser (info (hiddenHelper <*> ((,) <$> parser <*> some (strArgument (metavar "OTHER ARGUMENTS")))) (fullDesc <> progDesc pd)) return () where hiddenHelper = abortOption ShowHelpText (long "help" <> hidden <> internal) -- | 'option', specialized to 'Text'. textOption :: Mod OptionFields Text -> Parser Text textOption = option (T.pack <$> readerAsk) -- | 'argument', specialized to 'Text'. textArgument :: Mod ArgumentFields Text -> Parser Text textArgument = argument (T.pack <$> readerAsk) -- | Like 'optional', but returning a 'First'. optionalFirst :: Alternative f => f a -> f (First a) optionalFirst = fmap First . optional stack-1.1.2/src/Options/Applicative/Complicated.hs0000644000000000000000000001303712706265473020271 0ustar0000000000000000-- | Simple interface to complicated program arguments. -- -- This is a "fork" of the @optparse-simple@ package that has some workarounds for -- optparse-applicative issues that become problematic with programs that have many options and -- subcommands. Because it makes the interface more complex, these workarounds are not suitable for -- pushing upstream to optparse-applicative. module Options.Applicative.Complicated ( addCommand , addSubCommands , complicatedOptions , complicatedParser ) where import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Either import Control.Monad.Trans.Writer import Data.Monoid import Data.Version import Options.Applicative import Options.Applicative.Types import Options.Applicative.Builder.Internal import System.Environment -- | Generate and execute a complicated options parser. complicatedOptions :: Monoid a => Version -- ^ numeric version -> Maybe String -- ^ version string -> String -- ^ hpack numeric version, as string -> String -- ^ header -> String -- ^ program description -> Parser a -- ^ common settings -> Maybe (ParserFailure ParserHelp -> [String] -> IO (a,(b,a))) -- ^ optional handler for parser failure; 'handleParseResult' is called by -- default -> EitherT b (Writer (Mod CommandFields (b,a))) () -- ^ commands (use 'addCommand') -> IO (a,b) complicatedOptions numericVersion versionString numericHpackVersion h pd commonParser mOnFailure commandParser = do args <- getArgs (a,(b,c)) <- case execParserPure (prefs noBacktrack) parser args of Failure _ | null args -> withArgs ["--help"] (execParser parser) -- call onFailure handler if it's present and parsing options failed Failure f | Just onFailure <- mOnFailure -> onFailure f args parseResult -> handleParseResult parseResult return (mappend c a,b) where parser = info (helpOption <*> versionOptions <*> complicatedParser commonParser commandParser) desc desc = fullDesc <> header h <> progDesc pd versionOptions = case versionString of Nothing -> versionOption (showVersion numericVersion) Just s -> versionOption s <*> numericVersionOption <*> numericHpackVersionOption versionOption s = infoOption s (long "version" <> help "Show version") numericVersionOption = infoOption (showVersion numericVersion) (long "numeric-version" <> help "Show only version number") numericHpackVersionOption = infoOption numericHpackVersion (long "hpack-numeric-version" <> help "Show only hpack's version number") -- | Add a command to the options dispatcher. addCommand :: String -- ^ command string -> String -- ^ title of command -> String -- ^ footer of command help -> (a -> b) -- ^ constructor to wrap up command in common data type -> Parser c -- ^ common parser -> Parser a -- ^ command parser -> EitherT b (Writer (Mod CommandFields (b,c))) () addCommand cmd title footerStr constr = addCommand' cmd title footerStr (\a c -> (constr a,c)) -- | Add a command that takes sub-commands to the options dispatcher. addSubCommands :: Monoid c => String -- ^ command string -> String -- ^ title of command -> String -- ^ footer of command help -> Parser c -- ^ common parser -> EitherT b (Writer (Mod CommandFields (b,c))) () -- ^ sub-commands (use 'addCommand') -> EitherT b (Writer (Mod CommandFields (b,c))) () addSubCommands cmd title footerStr commonParser commandParser = addCommand' cmd title footerStr (\(c1,(a,c2)) c3 -> (a,mconcat [c3, c2, c1])) commonParser (complicatedParser commonParser commandParser) -- | Add a command to the options dispatcher. addCommand' :: String -- ^ command string -> String -- ^ title of command -> String -- ^ footer of command help -> (a -> c -> (b,c)) -- ^ constructor to wrap up command in common data type -> Parser c -- ^ common parser -> Parser a -- ^ command parser -> EitherT b (Writer (Mod CommandFields (b,c))) () addCommand' cmd title footerStr constr commonParser inner = lift (tell (command cmd (info (constr <$> inner <*> commonParser) (progDesc title <> footer footerStr)))) -- | Generate a complicated options parser. complicatedParser :: Monoid a => Parser a -- ^ common settings -> EitherT b (Writer (Mod CommandFields (b,a))) () -- ^ commands (use 'addCommand') -> Parser (a,(b,a)) complicatedParser commonParser commandParser = (,) <$> commonParser <*> case runWriter (runEitherT commandParser) of (Right (),d) -> hsubparser' d (Left b,_) -> pure (b,mempty) -- way to do in 'addCommand' | Subparser with @--help@ argument. Borrowed with slight modification -- from Options.Applicative.Extra. hsubparser' :: Mod CommandFields a -> Parser a hsubparser' m = mkParser d g rdr where Mod _ d g = m `mappend` metavar "COMMAND|FILE" (cmds, subs) = mkCommand m rdr = CmdReader cmds (fmap add_helper . subs) add_helper pinfo = pinfo { infoParser = infoParser pinfo <**> helpOption } -- | Non-hidden help option. helpOption :: Parser (a -> a) helpOption = abortOption ShowHelpText $ long "help" <> help "Show this help text" stack-1.1.2/src/Path/Extra.hs0000644000000000000000000000676312663440162014130 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} -- | Extra Path utilities. module Path.Extra (toFilePathNoTrailingSep ,dropRoot ,parseCollapsedAbsDir ,parseCollapsedAbsFile ,rejectMissingFile ,rejectMissingDir ) where import Control.Monad (liftM) import Control.Monad.Catch import Control.Monad.IO.Class import Data.Bool (bool) import Path import Path.IO import Path.Internal (Path(..)) import qualified System.FilePath as FP -- | Convert to FilePath but don't add a trailing slash. toFilePathNoTrailingSep :: Path loc Dir -> FilePath toFilePathNoTrailingSep = FP.dropTrailingPathSeparator . toFilePath -- | Collapse intermediate "." and ".." directories from path, then parse -- it with 'parseAbsDir'. -- (probably should be moved to the Path module) parseCollapsedAbsDir :: MonadThrow m => FilePath -> m (Path Abs Dir) parseCollapsedAbsDir = parseAbsDir . collapseFilePath -- | Collapse intermediate "." and ".." directories from path, then parse -- it with 'parseAbsFile'. -- (probably should be moved to the Path module) parseCollapsedAbsFile :: MonadThrow m => FilePath -> m (Path Abs File) parseCollapsedAbsFile = parseAbsFile . collapseFilePath -- | Collapse intermediate "." and ".." directories from a path. -- -- > collapseFilePath "./foo" == "foo" -- > collapseFilePath "/bar/../baz" == "/baz" -- > collapseFilePath "/../baz" == "/../baz" -- > collapseFilePath "parent/foo/baz/../bar" == "parent/foo/bar" -- > collapseFilePath "parent/foo/baz/../../bar" == "parent/bar" -- > collapseFilePath "parent/foo/.." == "parent" -- > collapseFilePath "/parent/foo/../../bar" == "/bar" -- -- (borrowed from @Text.Pandoc.Shared@) collapseFilePath :: FilePath -> FilePath collapseFilePath = FP.joinPath . reverse . foldl go [] . FP.splitDirectories where go rs "." = rs go r@(p:rs) ".." = case p of ".." -> "..":r (checkPathSeperator -> Just True) -> "..":r _ -> rs go _ (checkPathSeperator -> Just True) = [[FP.pathSeparator]] go rs x = x:rs isSingleton [] = Nothing isSingleton [x] = Just x isSingleton _ = Nothing checkPathSeperator = fmap FP.isPathSeparator . isSingleton -- | Drop the root (either @\/@ on POSIX or @C:\\@, @D:\\@, etc. on -- Windows). dropRoot :: Path Abs t -> Path Rel t dropRoot (Path l) = Path (FP.dropDrive l) -- | If given file in 'Maybe' does not exist, ensure we have 'Nothing'. This -- is to be used in conjunction with 'forgivingAbsence' and -- 'resolveFile'. -- -- Previously the idiom @forgivingAbsence (relsoveFile …)@ alone was used, -- which relied on 'canonicalizePath' throwing 'isDoesNotExistError' when -- path does not exist. As it turns out, this behavior is actually not -- intentional and unreliable, see -- . This was “fixed” in -- version @1.2.3.0@ of @directory@ package (now it never throws). To make -- it work with all versions, we need to use the following idiom: -- -- > forgivingAbsence (resolveFile …) >>= rejectMissingFile rejectMissingFile :: MonadIO m => Maybe (Path Abs File) -> m (Maybe (Path Abs File)) rejectMissingFile Nothing = return Nothing rejectMissingFile (Just p) = bool Nothing (Just p) `liftM` doesFileExist p -- | See 'rejectMissingFile'. rejectMissingDir :: MonadIO m => Maybe (Path Abs Dir) -> m (Maybe (Path Abs Dir)) rejectMissingDir Nothing = return Nothing rejectMissingDir (Just p) = bool Nothing (Just p) `liftM` doesDirExist p stack-1.1.2/src/Path/Find.hs0000644000000000000000000000755312674023022013715 0ustar0000000000000000{-# LANGUAGE DataKinds #-} -- | Finding files. module Path.Find (findFileUp ,findDirUp ,findFiles ,findInParents) where import Control.Exception (evaluate) import Control.DeepSeq (force) import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class import System.IO.Error (isPermissionError) import Data.List import Path import Path.IO hiding (findFiles) import System.PosixCompat.Files (getSymbolicLinkStatus, isSymbolicLink) -- | Find the location of a file matching the given predicate. findFileUp :: (MonadIO m,MonadThrow m) => Path Abs Dir -- ^ Start here. -> (Path Abs File -> Bool) -- ^ Predicate to match the file. -> Maybe (Path Abs Dir) -- ^ Do not ascend above this directory. -> m (Maybe (Path Abs File)) -- ^ Absolute file path. findFileUp = findPathUp snd -- | Find the location of a directory matching the given predicate. findDirUp :: (MonadIO m,MonadThrow m) => Path Abs Dir -- ^ Start here. -> (Path Abs Dir -> Bool) -- ^ Predicate to match the directory. -> Maybe (Path Abs Dir) -- ^ Do not ascend above this directory. -> m (Maybe (Path Abs Dir)) -- ^ Absolute directory path. findDirUp = findPathUp fst -- | Find the location of a path matching the given predicate. findPathUp :: (MonadIO m,MonadThrow m) => (([Path Abs Dir],[Path Abs File]) -> [Path Abs t]) -- ^ Choose path type from pair. -> Path Abs Dir -- ^ Start here. -> (Path Abs t -> Bool) -- ^ Predicate to match the path. -> Maybe (Path Abs Dir) -- ^ Do not ascend above this directory. -> m (Maybe (Path Abs t)) -- ^ Absolute path. findPathUp pathType dir p upperBound = do entries <- listDir dir case find p (pathType entries) of Just path -> return (Just path) Nothing | Just dir == upperBound -> return Nothing | parent dir == dir -> return Nothing | otherwise -> findPathUp pathType (parent dir) p upperBound -- | Find files matching predicate below a root directory. -- -- NOTE: this skips symbolic directory links, to avoid loops. This may -- not make sense for all uses of file finding. -- -- TODO: write one of these that traverses symbolic links but -- efficiently ignores loops. findFiles :: Path Abs Dir -- ^ Root directory to begin with. -> (Path Abs File -> Bool) -- ^ Predicate to match files. -> (Path Abs Dir -> Bool) -- ^ Predicate for which directories to traverse. -> IO [Path Abs File] -- ^ List of matching files. findFiles dir p traversep = do (dirs,files) <- catchJust (\ e -> if isPermissionError e then Just () else Nothing) (listDir dir) (\ _ -> return ([], [])) filteredFiles <- evaluate $ force (filter p files) filteredDirs <- filterM (fmap not . isSymLink) dirs subResults <- forM filteredDirs (\entry -> if traversep entry then findFiles entry p traversep else return []) return (concat (filteredFiles : subResults)) isSymLink :: Path Abs t -> IO Bool isSymLink = fmap isSymbolicLink . getSymbolicLinkStatus . toFilePath -- | @findInParents f path@ applies @f@ to @path@ and its 'parent's until -- it finds a 'Just' or reaches the root directory. findInParents :: MonadIO m => (Path Abs Dir -> m (Maybe a)) -> Path Abs Dir -> m (Maybe a) findInParents f path = do mres <- f path case mres of Just res -> return (Just res) Nothing -> do let next = parent path if next == path then return Nothing else findInParents f next stack-1.1.2/src/Stack/Build.hs0000644000000000000000000003660612717707440014261 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} -- | Build the project. module Stack.Build (build ,withLoadPackage ,mkBaseConfigOpts ,queryBuildInfo ,splitObjsWarning ,CabalVersionException(..)) where import Control.Exception (Exception) import Control.Monad import Control.Monad.Catch (MonadMask, MonadMask) import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Trans.Resource import Control.Monad.Trans.Unlift (MonadBaseUnlift) import Data.Aeson (Value (Object, Array), (.=), object) import Data.Function import qualified Data.HashMap.Strict as HM import Data.List ((\\)) import Data.List.Extra (groupSort) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import Data.Map.Strict (Map) import Data.Monoid import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) import qualified Data.Text.IO as TIO import Data.Text.Read (decimal) import Data.Typeable (Typeable) import qualified Data.Vector as V import qualified Data.Yaml as Yaml import Network.HTTP.Client.Conduit (HasHttpManager) import Path import Prelude hiding (FilePath, writeFile) import Stack.Build.ConstructPlan import Stack.Build.Execute import Stack.Build.Haddock import Stack.Build.Installed import Stack.Build.Source import Stack.Build.Target import Stack.Fetch as Fetch import Stack.GhcPkg import Stack.Package import Stack.Types import Stack.Types.Internal import System.FileLock (FileLock, unlockFile) #ifdef WINDOWS import System.Win32.Console (setConsoleCP, setConsoleOutputCP, getConsoleCP, getConsoleOutputCP) import qualified Control.Monad.Catch as Catch #endif type M env m = (MonadIO m,MonadReader env m,HasHttpManager env,HasBuildConfig env,MonadLogger m,MonadBaseUnlift IO m,MonadMask m,HasLogLevel env,HasEnvConfig env,HasTerminal env) -- | Build. -- -- If a buildLock is passed there is an important contract here. That lock must -- protect the snapshot, and it must be safe to unlock it if there are no further -- modifications to the snapshot to be performed by this build. build :: M env m => (Set (Path Abs File) -> IO ()) -- ^ callback after discovering all local files -> Maybe FileLock -> BuildOptsCLI -> m () build setLocalFiles mbuildLk boptsCli = fixCodePage $ do bopts <- asks (configBuild . getConfig) let profiling = boptsLibProfile bopts || boptsExeProfile bopts menv <- getMinimalEnvOverride (targets, mbp, locals, extraToBuild, sourceMap) <- loadSourceMap NeedTargets boptsCli -- Set local files, necessary for file watching stackYaml <- asks $ bcStackYaml . getBuildConfig liftIO $ setLocalFiles $ Set.insert stackYaml $ Set.unions $ map lpFiles locals (installedMap, globalDumpPkgs, snapshotDumpPkgs, localDumpPkgs) <- getInstalled menv GetInstalledOpts { getInstalledProfiling = profiling , getInstalledHaddock = shouldHaddockDeps bopts } sourceMap baseConfigOpts <- mkBaseConfigOpts boptsCli plan <- withLoadPackage menv $ \loadPackage -> constructPlan mbp baseConfigOpts locals extraToBuild localDumpPkgs loadPackage sourceMap installedMap -- If our work to do is all local, let someone else have a turn with the snapshot. -- They won't damage what's already in there. case (mbuildLk, allLocal plan) of -- NOTE: This policy is too conservative. In the future we should be able to -- schedule unlocking as an Action that happens after all non-local actions are -- complete. (Just lk,True) -> do $logDebug "All installs are local; releasing snapshot lock early." liftIO $ unlockFile lk _ -> return () checkCabalVersion warnAboutSplitObjs bopts warnIfExecutablesWithSameNameCouldBeOverwritten locals plan when (boptsPreFetch bopts) $ preFetch plan if boptsCLIDryrun boptsCli then printPlan plan else executePlan menv boptsCli baseConfigOpts locals globalDumpPkgs snapshotDumpPkgs localDumpPkgs installedMap targets plan -- | If all the tasks are local, they don't mutate anything outside of our local directory. allLocal :: Plan -> Bool allLocal = all (== Local) . map taskLocation . Map.elems . planTasks checkCabalVersion :: M env m => m () checkCabalVersion = do allowNewer <- asks (configAllowNewer . getConfig) cabalVer <- asks (envConfigCabalVersion . getEnvConfig) -- https://github.com/haskell/cabal/issues/2023 when (allowNewer && cabalVer < $(mkVersion "1.22")) $ throwM $ CabalVersionException $ "Error: --allow-newer requires at least Cabal version 1.22, but version " ++ versionString cabalVer ++ " was found." data CabalVersionException = CabalVersionException { unCabalVersionException :: String } deriving (Typeable) instance Show CabalVersionException where show = unCabalVersionException instance Exception CabalVersionException -- | See https://github.com/commercialhaskell/stack/issues/1198. warnIfExecutablesWithSameNameCouldBeOverwritten :: MonadLogger m => [LocalPackage] -> Plan -> m () warnIfExecutablesWithSameNameCouldBeOverwritten locals plan = forM_ (Map.toList warnings) $ \(exe,(toBuild,otherLocals)) -> do let exe_s | length toBuild > 1 = "several executables with the same name:" | otherwise = "executable" exesText pkgs = T.intercalate ", " ["'" <> packageNameText p <> ":" <> exe <> "'" | p <- pkgs] ($logWarn . T.unlines . concat) [ [ "Building " <> exe_s <> " " <> exesText toBuild <> "." ] , [ "Only one of them will be available via 'stack exec' or locally installed." | length toBuild > 1 ] , [ "Other executables with the same name might be overwritten: " <> exesText otherLocals <> "." | not (null otherLocals) ] ] where -- Cases of several local packages having executables with the same name. -- The Map entries have the following form: -- -- executable name: ( package names for executables that are being built -- , package names for other local packages that have an -- executable with the same name -- ) warnings :: Map Text ([PackageName],[PackageName]) warnings = Map.mapMaybe (\(pkgsToBuild,localPkgs) -> case (pkgsToBuild,NE.toList localPkgs \\ NE.toList pkgsToBuild) of (_ :| [],[]) -> -- We want to build the executable of single local package -- and there are no other local packages with an executable of -- the same name. Nothing to warn about, ignore. Nothing (_,otherLocals) -> -- We could be here for two reasons (or their combination): -- 1) We are building two or more executables with the same -- name that will end up overwriting each other. -- 2) In addition to the executable(s) that we want to build -- there are other local packages with an executable of the -- same name that might get overwritten. -- Both cases warrant a warning. Just (NE.toList pkgsToBuild,otherLocals)) (Map.intersectionWith (,) exesToBuild localExes) exesToBuild :: Map Text (NonEmpty PackageName) exesToBuild = collect [ (exe,pkgName) | (pkgName,task) <- Map.toList (planTasks plan) , isLocal task , exe <- (Set.toList . exeComponents . lpComponents . taskLP) task ] where isLocal Task{taskType = (TTLocal _)} = True isLocal _ = False taskLP Task{taskType = (TTLocal lp)} = lp taskLP _ = error "warnIfExecutablesWithSameNameCouldBeOverwritten/taskLP: task isn't local" localExes :: Map Text (NonEmpty PackageName) localExes = collect [ (exe,packageName pkg) | pkg <- map lpPackage locals , exe <- Set.toList (packageExes pkg) ] collect :: Ord k => [(k,v)] -> Map k (NonEmpty v) collect = Map.map NE.fromList . Map.fromDistinctAscList . groupSort warnAboutSplitObjs :: MonadLogger m => BuildOpts -> m () warnAboutSplitObjs bopts | boptsSplitObjs bopts = do $logWarn $ "Building with --split-objs is enabled. " <> T.pack splitObjsWarning warnAboutSplitObjs _ = return () splitObjsWarning :: String splitObjsWarning = unwords [ "Note that this feature is EXPERIMENTAL, and its behavior may be changed and improved." , "You will need to clean your workdirs before use. If you want to compile all dependencies" , "with split-objs, you will need to delete the snapshot (and all snapshots that could" , "reference that snapshot)." ] -- | Get the @BaseConfigOpts@ necessary for constructing configure options mkBaseConfigOpts :: (MonadIO m, MonadReader env m, HasEnvConfig env, MonadThrow m) => BuildOptsCLI -> m BaseConfigOpts mkBaseConfigOpts boptsCli = do bopts <- asks (configBuild . getConfig) snapDBPath <- packageDatabaseDeps localDBPath <- packageDatabaseLocal snapInstallRoot <- installationRootDeps localInstallRoot <- installationRootLocal packageExtraDBs <- packageDatabaseExtra return BaseConfigOpts { bcoSnapDB = snapDBPath , bcoLocalDB = localDBPath , bcoSnapInstallRoot = snapInstallRoot , bcoLocalInstallRoot = localInstallRoot , bcoBuildOpts = bopts , bcoBuildOptsCLI = boptsCli , bcoExtraDBs = packageExtraDBs } -- | Provide a function for loading package information from the package index withLoadPackage :: ( MonadIO m , HasHttpManager env , MonadReader env m , MonadBaseUnlift IO m , MonadMask m , MonadLogger m , HasEnvConfig env) => EnvOverride -> ((PackageName -> Version -> Map FlagName Bool -> [Text] -> IO Package) -> m a) -> m a withLoadPackage menv inner = do econfig <- asks getEnvConfig withCabalLoader menv $ \cabalLoader -> inner $ \name version flags ghcOptions -> do bs <- cabalLoader $ PackageIdentifier name version -- Intentionally ignore warnings, as it's not really -- appropriate to print a bunch of warnings out while -- resolving the package index. (_warnings,pkg) <- readPackageBS (depPackageConfig econfig flags ghcOptions) bs return pkg where -- | Package config to be used for dependencies depPackageConfig :: EnvConfig -> Map FlagName Bool -> [Text] -> PackageConfig depPackageConfig econfig flags ghcOptions = PackageConfig { packageConfigEnableTests = False , packageConfigEnableBenchmarks = False , packageConfigFlags = flags , packageConfigGhcOptions = ghcOptions , packageConfigCompilerVersion = envConfigCompilerVersion econfig , packageConfigPlatform = configPlatform (getConfig econfig) } -- | Set the code page for this process as necessary. Only applies to Windows. -- See: https://github.com/commercialhaskell/stack/issues/738 #ifdef WINDOWS fixCodePage :: M env m => m a -> m a fixCodePage inner = do mcp <- asks $ configModifyCodePage . getConfig ec <- asks getEnvConfig if mcp && getGhcVersion (envConfigCompilerVersion ec) < $(mkVersion "7.10.3") then fixCodePage' -- GHC >=7.10.3 doesn't need this code page hack. else inner where fixCodePage' = do origCPI <- liftIO getConsoleCP origCPO <- liftIO getConsoleOutputCP let setInput = origCPI /= expected setOutput = origCPO /= expected fixInput | setInput = Catch.bracket_ (liftIO $ do setConsoleCP expected) (liftIO $ setConsoleCP origCPI) | otherwise = id fixOutput | setInput = Catch.bracket_ (liftIO $ do setConsoleOutputCP expected) (liftIO $ setConsoleOutputCP origCPO) | otherwise = id case (setInput, setOutput) of (False, False) -> return () (True, True) -> warn "" (True, False) -> warn " input" (False, True) -> warn " output" fixInput $ fixOutput inner expected = 65001 -- UTF-8 warn typ = $logInfo $ T.concat [ "Setting" , typ , " codepage to UTF-8 (65001) to ensure correct output from GHC" ] #else fixCodePage :: a -> a fixCodePage = id #endif -- | Query information about the build and print the result to stdout in YAML format. queryBuildInfo :: M env m => [Text] -- ^ selectors -> m () queryBuildInfo selectors0 = rawBuildInfo >>= select id selectors0 >>= liftIO . TIO.putStrLn . decodeUtf8 . Yaml.encode where select _ [] value = return value select front (sel:sels) value = case value of Object o -> case HM.lookup sel o of Nothing -> err "Selector not found" Just value' -> cont value' Array v -> case decimal sel of Right (i, "") | i >= 0 && i < V.length v -> cont $ v V.! i | otherwise -> err "Index out of range" _ -> err "Encountered array and needed numeric selector" _ -> err $ "Cannot apply selector to " ++ show value where cont = select (front . (sel:)) sels err msg = error $ msg ++ ": " ++ show (front [sel]) -- | Get the raw build information object rawBuildInfo :: M env m => m Value rawBuildInfo = do (_, _mbp, locals, _extraToBuild, _sourceMap) <- loadSourceMap NeedTargets defaultBuildOptsCLI return $ object [ "locals" .= Object (HM.fromList $ map localToPair locals) ] where localToPair lp = (T.pack $ packageNameString $ packageName p, value) where p = lpPackage lp value = object [ "version" .= packageVersion p , "path" .= toFilePath (lpDir lp) ] stack-1.1.2/src/Stack/Build/Cache.hs0000644000000000000000000003003512717707440015252 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE OverloadedStrings #-} -- | Cache information about previous builds module Stack.Build.Cache ( tryGetBuildCache , tryGetConfigCache , tryGetCabalMod , getInstalledExes , buildCacheTimes , tryGetFlagCache , deleteCaches , markExeInstalled , markExeNotInstalled , writeFlagCache , writeBuildCache , writeConfigCache , writeCabalMod , setTestSuccess , unsetTestSuccess , checkTestSuccess , writePrecompiledCache , readPrecompiledCache ) where import Control.Exception.Enclosed (handleIO) import Control.Monad.Catch (MonadThrow, MonadCatch) import Control.Monad.IO.Class import Control.Monad.Logger (MonadLogger, logDebug) import Control.Monad.Reader import qualified Crypto.Hash.SHA256 as SHA256 import qualified Data.Binary as Binary (encode) import Data.Binary.VersionTagged import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Base16 as B16 import Data.Map (Map) import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid ((<>)) import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic) import Path import Path.IO import Stack.Types.Build import Stack.Constants import Stack.Types -- | Directory containing files to mark an executable as installed exeInstalledDir :: (MonadReader env m, HasEnvConfig env, MonadThrow m) => InstallLocation -> m (Path Abs Dir) exeInstalledDir Snap = ( $(mkRelDir "installed-packages")) `liftM` installationRootDeps exeInstalledDir Local = ( $(mkRelDir "installed-packages")) `liftM` installationRootLocal -- | Get all of the installed executables getInstalledExes :: (MonadReader env m, HasEnvConfig env, MonadIO m, MonadThrow m) => InstallLocation -> m [PackageIdentifier] getInstalledExes loc = do dir <- exeInstalledDir loc (_, files) <- liftIO $ handleIO (const $ return ([], [])) $ listDir dir return $ mapMaybe (parsePackageIdentifierFromString . toFilePath . filename) files -- | Mark the given executable as installed markExeInstalled :: (MonadReader env m, HasEnvConfig env, MonadIO m, MonadThrow m) => InstallLocation -> PackageIdentifier -> m () markExeInstalled loc ident = do dir <- exeInstalledDir loc ensureDir dir ident' <- parseRelFile $ packageIdentifierString ident let fp = toFilePath $ dir ident' -- TODO consideration for the future: list all of the executables -- installed, and invalidate this file in getInstalledExes if they no -- longer exist liftIO $ writeFile fp "Installed" -- | Mark the given executable as not installed markExeNotInstalled :: (MonadReader env m, HasEnvConfig env, MonadIO m, MonadCatch m) => InstallLocation -> PackageIdentifier -> m () markExeNotInstalled loc ident = do dir <- exeInstalledDir loc ident' <- parseRelFile $ packageIdentifierString ident ignoringAbsence (removeFile $ dir ident') -- | Stored on disk to know whether the flags have changed or any -- files have changed. data BuildCache = BuildCache { buildCacheTimes :: !(Map FilePath FileCacheInfo) -- ^ Modification times of files. } deriving (Generic) instance Binary BuildCache instance HasStructuralInfo BuildCache instance HasSemanticVersion BuildCache instance NFData BuildCache -- | Try to read the dirtiness cache for the given package directory. tryGetBuildCache :: (MonadIO m, MonadReader env m, MonadThrow m, HasEnvConfig env) => Path Abs Dir -> m (Maybe (Map FilePath FileCacheInfo)) tryGetBuildCache = liftM (fmap buildCacheTimes) . tryGetCache buildCacheFile -- | Try to read the dirtiness cache for the given package directory. tryGetConfigCache :: (MonadIO m, MonadReader env m, MonadThrow m, HasEnvConfig env) => Path Abs Dir -> m (Maybe ConfigCache) tryGetConfigCache = tryGetCache configCacheFile -- | Try to read the mod time of the cabal file from the last build tryGetCabalMod :: (MonadIO m, MonadReader env m, MonadThrow m, HasEnvConfig env) => Path Abs Dir -> m (Maybe ModTime) tryGetCabalMod = tryGetCache configCabalMod -- | Try to load a cache. tryGetCache :: (MonadIO m, BinarySchema a) => (Path Abs Dir -> m (Path Abs File)) -> Path Abs Dir -> m (Maybe a) tryGetCache get' dir = do fp <- get' dir decodeFileOrFailDeep fp -- | Write the dirtiness cache for this package's files. writeBuildCache :: (MonadIO m, MonadReader env m, MonadThrow m, HasEnvConfig env) => Path Abs Dir -> Map FilePath FileCacheInfo -> m () writeBuildCache dir times = writeCache dir buildCacheFile BuildCache { buildCacheTimes = times } -- | Write the dirtiness cache for this package's configuration. writeConfigCache :: (MonadIO m, MonadReader env m, MonadThrow m, HasEnvConfig env) => Path Abs Dir -> ConfigCache -> m () writeConfigCache dir = writeCache dir configCacheFile -- | See 'tryGetCabalMod' writeCabalMod :: (MonadIO m, MonadReader env m, MonadThrow m, HasEnvConfig env) => Path Abs Dir -> ModTime -> m () writeCabalMod dir = writeCache dir configCabalMod -- | Delete the caches for the project. deleteCaches :: (MonadIO m, MonadReader env m, MonadCatch m, HasEnvConfig env) => Path Abs Dir -> m () deleteCaches dir = do {- FIXME confirm that this is acceptable to remove bfp <- buildCacheFile dir removeFileIfExists bfp -} cfp <- configCacheFile dir ignoringAbsence (removeFile cfp) -- | Write to a cache. writeCache :: (BinarySchema a, MonadIO m) => Path Abs Dir -> (Path Abs Dir -> m (Path Abs File)) -> a -> m () writeCache dir get' content = do fp <- get' dir taggedEncodeFile fp content flagCacheFile :: (MonadIO m, MonadThrow m, MonadReader env m, HasEnvConfig env) => Installed -> m (Path Abs File) flagCacheFile installed = do rel <- parseRelFile $ case installed of Library _ gid -> ghcPkgIdString gid Executable ident -> packageIdentifierString ident dir <- flagCacheLocal return $ dir rel -- | Loads the flag cache for the given installed extra-deps tryGetFlagCache :: (MonadIO m, MonadThrow m, MonadReader env m, HasEnvConfig env) => Installed -> m (Maybe ConfigCache) tryGetFlagCache gid = do fp <- flagCacheFile gid decodeFileOrFailDeep fp writeFlagCache :: (MonadIO m, MonadReader env m, HasEnvConfig env, MonadThrow m) => Installed -> ConfigCache -> m () writeFlagCache gid cache = do file <- flagCacheFile gid liftIO $ do ensureDir (parent file) taggedEncodeFile file cache -- | Mark a test suite as having succeeded setTestSuccess :: (MonadIO m, MonadThrow m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -> m () setTestSuccess dir = writeCache dir testSuccessFile True -- | Mark a test suite as not having succeeded unsetTestSuccess :: (MonadIO m, MonadThrow m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -> m () unsetTestSuccess dir = writeCache dir testSuccessFile False -- | Check if the test suite already passed checkTestSuccess :: (MonadIO m, MonadThrow m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -> m Bool checkTestSuccess dir = liftM (fromMaybe False) (tryGetCache testSuccessFile dir) -------------------------------------- -- Precompiled Cache -- -- Idea is simple: cache information about packages built in other snapshots, -- and then for identical matches (same flags, config options, dependencies) -- just copy over the executables and reregister the libraries. -------------------------------------- -- | The file containing information on the given package/configuration -- combination. The filename contains a hash of the non-directory configure -- options for quick lookup if there's a match. precompiledCacheFile :: (MonadThrow m, MonadReader env m, HasEnvConfig env, MonadLogger m) => PackageIdentifier -> ConfigureOpts -> Set GhcPkgId -- ^ dependencies -> m (Path Abs File) precompiledCacheFile pkgident copts installedPackageIDs = do ec <- asks getEnvConfig compiler <- parseRelDir $ compilerVersionString $ envConfigCompilerVersion ec cabal <- parseRelDir $ versionString $ envConfigCabalVersion ec pkg <- parseRelDir $ packageIdentifierString pkgident -- In Cabal versions 1.22 and later, the configure options contain the -- installed package IDs, which is what we need for a unique hash. -- Unfortunately, earlier Cabals don't have the information, so we must -- supplement it with the installed package IDs directly. In 20/20 -- hindsight, we would simply always do that, but previous Stack releases -- used only the options, and we don't want to invalidate old caches -- unnecessarily. -- -- See issue: https://github.com/commercialhaskell/stack/issues/1103 let computeCacheSource input = do $logDebug $ "Precompiled cache input = " <> T.pack (show input) return $ Binary.encode input cacheInput <- if envConfigCabalVersion ec >= $(mkVersion "1.22") then computeCacheSource (coNoDirs copts) else computeCacheSource (coNoDirs copts, installedPackageIDs) -- We only pay attention to non-directory options. We don't want to avoid a -- cache hit just because it was installed in a different directory. copts' <- parseRelFile $ S8.unpack $ B16.encode $ SHA256.hashlazy cacheInput platformRelDir <- platformGhcRelDir return $ getStackRoot ec $(mkRelDir "precompiled") platformRelDir compiler cabal pkg copts' -- | Write out information about a newly built package writePrecompiledCache :: (MonadThrow m, MonadReader env m, HasEnvConfig env, MonadIO m, MonadLogger m) => BaseConfigOpts -> PackageIdentifier -> ConfigureOpts -> Set GhcPkgId -- ^ dependencies -> Installed -- ^ library -> Set Text -- ^ executables -> m () writePrecompiledCache baseConfigOpts pkgident copts depIDs mghcPkgId exes = do file <- precompiledCacheFile pkgident copts depIDs ensureDir (parent file) mlibpath <- case mghcPkgId of Executable _ -> return Nothing Library _ ipid -> liftM Just $ do ipid' <- parseRelFile $ ghcPkgIdString ipid ++ ".conf" return $ toFilePath $ bcoSnapDB baseConfigOpts ipid' exes' <- forM (Set.toList exes) $ \exe -> do name <- parseRelFile $ T.unpack exe return $ toFilePath $ bcoSnapInstallRoot baseConfigOpts bindirSuffix name liftIO $ taggedEncodeFile file PrecompiledCache { pcLibrary = mlibpath , pcExes = exes' } -- | Check the cache for a precompiled package matching the given -- configuration. readPrecompiledCache :: (MonadThrow m, MonadReader env m, HasEnvConfig env, MonadIO m, MonadLogger m) => PackageIdentifier -- ^ target package -> ConfigureOpts -> Set GhcPkgId -- ^ dependencies -> m (Maybe PrecompiledCache) readPrecompiledCache pkgident copts depIDs = do file <- precompiledCacheFile pkgident copts depIDs decodeFileOrFailDeep file stack-1.1.2/src/Stack/Build/ConstructPlan.hs0000644000000000000000000007225112717707440017054 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} -- | Construct a @Plan@ for how to build module Stack.Build.ConstructPlan ( constructPlan ) where import Control.Arrow ((&&&)) import Control.Exception.Lifted import Control.Monad import Control.Monad.Catch (MonadCatch) import Control.Monad.IO.Class import Control.Monad.Logger (MonadLogger, logWarn) import Control.Monad.RWS.Strict import Control.Monad.Trans.Resource import Data.Either import Data.Function import Data.List import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import qualified Data.Map.Strict as Map import Data.Maybe import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import qualified Distribution.Package as Cabal import qualified Distribution.Version as Cabal import GHC.Generics (Generic) import Generics.Deriving.Monoid (memptydefault, mappenddefault) import Network.HTTP.Client.Conduit (HasHttpManager) import Prelude hiding (pi, writeFile) import Stack.Build.Cache import Stack.Build.Haddock import Stack.Build.Installed import Stack.Build.Source import Stack.BuildPlan import Stack.Package import Stack.PackageDump import Stack.PackageIndex import Stack.Types data PackageInfo = PIOnlyInstalled InstallLocation Installed | PIOnlySource PackageSource | PIBoth PackageSource Installed combineSourceInstalled :: PackageSource -> (InstallLocation, Installed) -> PackageInfo combineSourceInstalled ps (location, installed) = assert (piiVersion ps == installedVersion installed) $ assert (piiLocation ps == location) $ case location of -- Always trust something in the snapshot Snap -> PIOnlyInstalled location installed Local -> PIBoth ps installed type CombinedMap = Map PackageName PackageInfo combineMap :: SourceMap -> InstalledMap -> CombinedMap combineMap = Map.mergeWithKey (\_ s i -> Just $ combineSourceInstalled s i) (fmap PIOnlySource) (fmap (uncurry PIOnlyInstalled)) data AddDepRes = ADRToInstall Task | ADRFound InstallLocation Installed deriving Show data W = W { wFinals :: !(Map PackageName (Either ConstructPlanException Task)) , wInstall :: !(Map Text InstallLocation) -- ^ executable to be installed, and location where the binary is placed , wDirty :: !(Map PackageName Text) -- ^ why a local package is considered dirty , wDeps :: !(Set PackageName) -- ^ Packages which count as dependencies , wWarnings :: !([Text] -> [Text]) -- ^ Warnings } deriving Generic instance Monoid W where mempty = memptydefault mappend = mappenddefault type M = RWST Ctx W (Map PackageName (Either ConstructPlanException AddDepRes)) IO data Ctx = Ctx { mbp :: !MiniBuildPlan , baseConfigOpts :: !BaseConfigOpts , loadPackage :: !(PackageName -> Version -> Map FlagName Bool -> [Text] -> IO Package) , combinedMap :: !CombinedMap , toolToPackages :: !(Cabal.Dependency -> Map PackageName VersionRange) , ctxEnvConfig :: !EnvConfig , callStack :: ![PackageName] , extraToBuild :: !(Set PackageName) , getVersions :: !(PackageName -> IO (Set Version)) , wanted :: !(Set PackageName) , localNames :: !(Set PackageName) } instance HasStackRoot Ctx instance HasPlatform Ctx instance HasGHCVariant Ctx instance HasConfig Ctx instance HasBuildConfig Ctx where getBuildConfig = getBuildConfig . getEnvConfig instance HasEnvConfig Ctx where getEnvConfig = ctxEnvConfig constructPlan :: forall env m. (MonadCatch m, MonadReader env m, HasEnvConfig env, MonadIO m, MonadLogger m, MonadBaseControl IO m, HasHttpManager env) => MiniBuildPlan -> BaseConfigOpts -> [LocalPackage] -> Set PackageName -- ^ additional packages that must be built -> [DumpPackage () ()] -- ^ locally registered -> (PackageName -> Version -> Map FlagName Bool -> [Text] -> IO Package) -- ^ load upstream package -> SourceMap -> InstalledMap -> m Plan constructPlan mbp0 baseConfigOpts0 locals extraToBuild0 localDumpPkgs loadPackage0 sourceMap installedMap = do let locallyRegistered = Map.fromList $ map (dpGhcPkgId &&& dpPackageIdent) localDumpPkgs getVersions0 <- getPackageVersionsIO econfig <- asks getEnvConfig let onWanted = void . addDep False . packageName . lpPackage let inner = do mapM_ onWanted $ filter lpWanted locals mapM_ (addDep False) $ Set.toList extraToBuild0 ((), m, W efinals installExes dirtyReason deps warnings) <- liftIO $ runRWST inner (ctx econfig getVersions0) M.empty mapM_ $logWarn (warnings []) let toEither (_, Left e) = Left e toEither (k, Right v) = Right (k, v) (errlibs, adrs) = partitionEithers $ map toEither $ M.toList m (errfinals, finals) = partitionEithers $ map toEither $ M.toList efinals errs = errlibs ++ errfinals if null errs then do let toTask (_, ADRFound _ _) = Nothing toTask (name, ADRToInstall task) = Just (name, task) tasks = M.fromList $ mapMaybe toTask adrs takeSubset = case boptsCLIBuildSubset $ bcoBuildOptsCLI baseConfigOpts0 of BSAll -> id BSOnlySnapshot -> stripLocals BSOnlyDependencies -> stripNonDeps deps return $ takeSubset Plan { planTasks = tasks , planFinals = M.fromList finals , planUnregisterLocal = mkUnregisterLocal tasks dirtyReason locallyRegistered sourceMap , planInstallExes = if boptsInstallExes $ bcoBuildOpts baseConfigOpts0 then installExes else Map.empty } else throwM $ ConstructPlanExceptions errs (bcStackYaml $ getBuildConfig econfig) where ctx econfig getVersions0 = Ctx { mbp = mbp0 , baseConfigOpts = baseConfigOpts0 , loadPackage = loadPackage0 , combinedMap = combineMap sourceMap installedMap , toolToPackages = \(Cabal.Dependency name _) -> maybe Map.empty (Map.fromSet (const Cabal.anyVersion)) $ Map.lookup (T.pack . packageNameString . fromCabalPackageName $ name) toolMap , ctxEnvConfig = econfig , callStack = [] , extraToBuild = extraToBuild0 , getVersions = getVersions0 , wanted = wantedLocalPackages locals , localNames = Set.fromList $ map (packageName . lpPackage) locals } -- TODO Currently, this will only consider and install tools from the -- snapshot. It will not automatically install build tools from extra-deps -- or local packages. toolMap = getToolMap mbp0 -- | Determine which packages to unregister based on the given tasks and -- already registered local packages mkUnregisterLocal :: Map PackageName Task -> Map PackageName Text -> Map GhcPkgId PackageIdentifier -> SourceMap -> Map GhcPkgId (PackageIdentifier, Maybe Text) mkUnregisterLocal tasks dirtyReason locallyRegistered sourceMap = Map.unions $ map toUnregisterMap $ Map.toList locallyRegistered where toUnregisterMap (gid, ident) = case M.lookup name tasks of Nothing -> case M.lookup name sourceMap of Just (PSUpstream _ Snap _ _ _) -> Map.singleton gid ( ident , Just "Switching to snapshot installed package" ) _ -> Map.empty Just _ -> Map.singleton gid ( ident , Map.lookup name dirtyReason ) where name = packageIdentifierName ident addFinal :: LocalPackage -> Package -> Bool -> M () addFinal lp package isAllInOne = do depsRes <- addPackageDeps False package res <- case depsRes of Left e -> return $ Left e Right (missing, present, _minLoc) -> do ctx <- ask return $ Right Task { taskProvides = PackageIdentifier (packageName package) (packageVersion package) , taskConfigOpts = TaskConfigOpts missing $ \missing' -> let allDeps = Map.union present missing' in configureOpts (getEnvConfig ctx) (baseConfigOpts ctx) allDeps True -- local Local package , taskPresent = present , taskType = TTLocal lp , taskAllInOne = isAllInOne } tell mempty { wFinals = Map.singleton (packageName package) res } addDep :: Bool -- ^ is this being used by a dependency? -> PackageName -> M (Either ConstructPlanException AddDepRes) addDep treatAsDep' name = do ctx <- ask let treatAsDep = treatAsDep' || name `Set.notMember` wanted ctx when treatAsDep $ markAsDep name m <- get case Map.lookup name m of Just res -> return res Nothing -> do res <- if name `elem` callStack ctx then return $ Left $ DependencyCycleDetected $ name : callStack ctx else local (\ctx' -> ctx' { callStack = name : callStack ctx' }) $ case Map.lookup name $ combinedMap ctx of -- TODO look up in the package index and see if there's a -- recommendation available Nothing -> return $ Left $ UnknownPackage name Just (PIOnlyInstalled loc installed) -> do -- slightly hacky, no flags since they likely won't affect executable names tellExecutablesUpstream name (installedVersion installed) loc Map.empty return $ Right $ ADRFound loc installed Just (PIOnlySource ps) -> do tellExecutables name ps installPackage treatAsDep name ps Nothing Just (PIBoth ps installed) -> do tellExecutables name ps installPackage treatAsDep name ps (Just installed) modify $ Map.insert name res return res tellExecutables :: PackageName -> PackageSource -> M () tellExecutables _ (PSLocal lp) | lpWanted lp = tellExecutablesPackage Local $ lpPackage lp | otherwise = return () -- Ignores ghcOptions because they don't matter for enumerating -- executables. tellExecutables name (PSUpstream version loc flags _ghcOptions _gitSha) = tellExecutablesUpstream name version loc flags tellExecutablesUpstream :: PackageName -> Version -> InstallLocation -> Map FlagName Bool -> M () tellExecutablesUpstream name version loc flags = do ctx <- ask when (name `Set.member` extraToBuild ctx) $ do p <- liftIO $ loadPackage ctx name version flags [] tellExecutablesPackage loc p tellExecutablesPackage :: InstallLocation -> Package -> M () tellExecutablesPackage loc p = do cm <- asks combinedMap -- Determine which components are enabled so we know which ones to copy let myComps = case Map.lookup (packageName p) cm of Nothing -> assert False Set.empty Just (PIOnlyInstalled _ _) -> Set.empty Just (PIOnlySource ps) -> goSource ps Just (PIBoth ps _) -> goSource ps goSource (PSLocal lp) | lpWanted lp = exeComponents (lpComponents lp) | otherwise = Set.empty goSource (PSUpstream{}) = Set.empty tell mempty { wInstall = Map.fromList $ map (, loc) $ Set.toList $ filterComps myComps $ packageExes p } where filterComps myComps x | Set.null myComps = x | otherwise = Set.intersection x myComps installPackage :: Bool -- ^ is this being used by a dependency? -> PackageName -> PackageSource -> Maybe Installed -> M (Either ConstructPlanException AddDepRes) installPackage treatAsDep name ps minstalled = do ctx <- ask case ps of PSUpstream version _ flags ghcOptions _ -> do package <- liftIO $ loadPackage ctx name version flags ghcOptions resolveDepsAndInstall False treatAsDep ps package minstalled PSLocal lp -> case lpTestBench lp of Nothing -> resolveDepsAndInstall False treatAsDep ps (lpPackage lp) minstalled Just tb -> do -- Attempt to find a plan which performs an all-in-one -- build. Ignore the writer action + reset the state if -- it fails. s <- get res <- pass $ do res <- addPackageDeps treatAsDep tb let writerFunc w = case res of Left _ -> mempty _ -> w return (res, writerFunc) case res of Right deps -> do adr <- installPackageGivenDeps True ps tb minstalled deps -- FIXME: this redundantly adds the deps (but -- they'll all just get looked up in the map) addFinal lp tb True return $ Right adr Left _ -> do -- Reset the state to how it was before -- attempting to find an all-in-one build -- plan. put s -- Otherwise, fall back on building the -- tests / benchmarks in a separate step. res' <- resolveDepsAndInstall False treatAsDep ps (lpPackage lp) minstalled when (isRight res') $ do -- Insert it into the map so that it's -- available for addFinal. modify $ Map.insert name res' addFinal lp tb False return res' resolveDepsAndInstall :: Bool -> Bool -> PackageSource -> Package -> Maybe Installed -> M (Either ConstructPlanException AddDepRes) resolveDepsAndInstall isAllInOne treatAsDep ps package minstalled = do res <- addPackageDeps treatAsDep package case res of Left err -> return $ Left err Right deps -> liftM Right $ installPackageGivenDeps isAllInOne ps package minstalled deps installPackageGivenDeps :: Bool -> PackageSource -> Package -> Maybe Installed -> ( Set PackageIdentifier , Map PackageIdentifier GhcPkgId , InstallLocation ) -> M AddDepRes installPackageGivenDeps isAllInOne ps package minstalled (missing, present, minLoc) = do let name = packageName package ctx <- ask mRightVersionInstalled <- case (minstalled, Set.null missing) of (Just installed, True) -> do shouldInstall <- checkDirtiness ps installed package present (wanted ctx) return $ if shouldInstall then Nothing else Just installed (Just _, False) -> do let t = T.intercalate ", " $ map (T.pack . packageNameString . packageIdentifierName) (Set.toList missing) tell mempty { wDirty = Map.singleton name $ "missing dependencies: " <> addEllipsis t } return Nothing (Nothing, _) -> return Nothing return $ case mRightVersionInstalled of Just installed -> ADRFound (piiLocation ps) installed Nothing -> ADRToInstall Task { taskProvides = PackageIdentifier (packageName package) (packageVersion package) , taskConfigOpts = TaskConfigOpts missing $ \missing' -> let allDeps = Map.union present missing' destLoc = piiLocation ps <> minLoc in configureOpts (getEnvConfig ctx) (baseConfigOpts ctx) allDeps (psLocal ps) -- An assertion to check for a recurrence of -- https://github.com/commercialhaskell/stack/issues/345 (assert (destLoc == piiLocation ps) destLoc) package , taskPresent = present , taskType = case ps of PSLocal lp -> TTLocal lp PSUpstream _ loc _ _ sha -> TTUpstream package (loc <> minLoc) sha , taskAllInOne = isAllInOne } addEllipsis :: Text -> Text addEllipsis t | T.length t < 100 = t | otherwise = T.take 97 t <> "..." addPackageDeps :: Bool -- ^ is this being used by a dependency? -> Package -> M (Either ConstructPlanException (Set PackageIdentifier, Map PackageIdentifier GhcPkgId, InstallLocation)) addPackageDeps treatAsDep package = do ctx <- ask deps' <- packageDepsWithTools package deps <- forM (Map.toList deps') $ \(depname, range) -> do eres <- addDep treatAsDep depname let getLatestApplicable = do vs <- liftIO $ getVersions ctx depname return (latestApplicableVersion range vs) case eres of Left e -> do let bd = case e of UnknownPackage name -> assert (name == depname) NotInBuildPlan _ -> Couldn'tResolveItsDependencies mlatestApplicable <- getLatestApplicable return $ Left (depname, (range, mlatestApplicable, bd)) Right adr -> do inRange <- if adrVersion adr `withinRange` range then return True else do let warn reason = tell mempty { wWarnings = (msg:) } where msg = T.concat [ "WARNING: Ignoring out of range dependency" , reason , ": " , T.pack $ packageIdentifierString $ PackageIdentifier depname (adrVersion adr) , ". " , T.pack $ packageNameString $ packageName package , " requires: " , versionRangeText range ] allowNewer <- asks $ configAllowNewer . getConfig if allowNewer then do warn " (allow-newer enabled)" return True else do x <- inSnapshot (packageName package) (packageVersion package) y <- inSnapshot depname (adrVersion adr) if x && y then do warn " (trusting snapshot over Hackage revisions)" return True else return False if inRange then case adr of ADRToInstall task -> return $ Right (Set.singleton $ taskProvides task, Map.empty, taskLocation task) ADRFound loc (Executable _) -> return $ Right (Set.empty, Map.empty, loc) ADRFound loc (Library ident gid) -> return $ Right (Set.empty, Map.singleton ident gid, loc) else do mlatestApplicable <- getLatestApplicable return $ Left (depname, (range, mlatestApplicable, DependencyMismatch $ adrVersion adr)) case partitionEithers deps of ([], pairs) -> return $ Right $ mconcat pairs (errs, _) -> return $ Left $ DependencyPlanFailures package (Map.fromList errs) where adrVersion (ADRToInstall task) = packageIdentifierVersion $ taskProvides task adrVersion (ADRFound _ installed) = installedVersion installed checkDirtiness :: PackageSource -> Installed -> Package -> Map PackageIdentifier GhcPkgId -> Set PackageName -> M Bool checkDirtiness ps installed package present wanted = do ctx <- ask moldOpts <- tryGetFlagCache installed let configOpts = configureOpts (getEnvConfig ctx) (baseConfigOpts ctx) present (psLocal ps) (piiLocation ps) -- should be Local always package buildOpts = bcoBuildOpts (baseConfigOpts ctx) wantConfigCache = ConfigCache { configCacheOpts = configOpts , configCacheDeps = Set.fromList $ Map.elems present , configCacheComponents = case ps of PSLocal lp -> Set.map renderComponent $ lpComponents lp PSUpstream{} -> Set.empty , configCacheHaddock = shouldHaddockPackage buildOpts wanted (packageName package) || -- Disabling haddocks when old config had haddocks doesn't make dirty. maybe False configCacheHaddock moldOpts } let mreason = case moldOpts of Nothing -> Just "old configure information not found" Just oldOpts | Just reason <- describeConfigDiff config oldOpts wantConfigCache -> Just reason | True <- psForceDirty ps -> Just "--force-dirty specified" | Just files <- psDirty ps -> Just $ "local file changes: " <> addEllipsis (T.pack $ unwords $ Set.toList files) | otherwise -> Nothing config = getConfig ctx case mreason of Nothing -> return False Just reason -> do tell mempty { wDirty = Map.singleton (packageName package) reason } return True describeConfigDiff :: Config -> ConfigCache -> ConfigCache -> Maybe Text describeConfigDiff config old new | not (configCacheDeps new `Set.isSubsetOf` configCacheDeps old) = Just "dependencies changed" | not $ Set.null newComponents = Just $ "components added: " `T.append` T.intercalate ", " (map (decodeUtf8With lenientDecode) (Set.toList newComponents)) | not (configCacheHaddock old) && configCacheHaddock new = Just "rebuilding with haddocks" | oldOpts /= newOpts = Just $ T.pack $ concat [ "flags changed from " , show oldOpts , " to " , show newOpts ] | otherwise = Nothing where stripGhcOptions = go where go [] = [] go ("--ghc-option":x:xs) = go' x xs go ("--ghc-options":x:xs) = go' x xs go ((T.stripPrefix "--ghc-option=" -> Just x):xs) = go' x xs go ((T.stripPrefix "--ghc-options=" -> Just x):xs) = go' x xs go (x:xs) = x : go xs go' x xs = checkKeepers x $ go xs checkKeepers x xs = case filter isKeeper $ T.words x of [] -> xs keepers -> "--ghc-options" : T.unwords keepers : xs -- GHC options which affect build results and therefore should always -- force a rebuild -- -- For the most part, we only care about options generated by Stack -- itself isKeeper = (== "-fhpc") -- more to be added later userOpts = filter (not . isStackOpt) . (if configRebuildGhcOptions config then id else stripGhcOptions) . map T.pack . (\(ConfigureOpts x y) -> x ++ y) . configCacheOpts (oldOpts, newOpts) = removeMatching (userOpts old) (userOpts new) removeMatching (x:xs) (y:ys) | x == y = removeMatching xs ys removeMatching xs ys = (xs, ys) newComponents = configCacheComponents new `Set.difference` configCacheComponents old psForceDirty :: PackageSource -> Bool psForceDirty (PSLocal lp) = lpForceDirty lp psForceDirty (PSUpstream {}) = False psDirty :: PackageSource -> Maybe (Set FilePath) psDirty (PSLocal lp) = lpDirtyFiles lp psDirty (PSUpstream {}) = Nothing -- files never change in an upstream package psLocal :: PackageSource -> Bool psLocal (PSLocal _) = True psLocal (PSUpstream {}) = False -- | Get all of the dependencies for a given package, including guessed build -- tool dependencies. packageDepsWithTools :: Package -> M (Map PackageName VersionRange) packageDepsWithTools p = do ctx <- ask -- TODO: it would be cool to defer these warnings until there's an -- actual issue building the package. -- TODO: check if the tool is on the path before warning? let toEither (Cabal.Dependency (Cabal.PackageName name) _) mp = case Map.toList mp of [] -> Left (NoToolFound name (packageName p)) [_] -> Right mp xs -> Left (AmbiguousToolsFound name (packageName p) (map fst xs)) (warnings, toolDeps) = partitionEithers $ map (\dep -> toEither dep (toolToPackages ctx dep)) (packageTools p) tell mempty { wWarnings = (map toolWarningText warnings ++) } when (any isNoToolFound warnings) $ do let msg = T.unlines [ "Missing build-tools may be caused by dependencies of the build-tool being overridden by extra-deps." , "This should be fixed soon - see this issue https://github.com/commercialhaskell/stack/issues/595" ] tell mempty { wWarnings = (msg:) } return $ Map.unionsWith intersectVersionRanges $ packageDeps p : toolDeps data ToolWarning = NoToolFound String PackageName | AmbiguousToolsFound String PackageName [PackageName] isNoToolFound :: ToolWarning -> Bool isNoToolFound NoToolFound{} = True isNoToolFound _ = False toolWarningText :: ToolWarning -> Text toolWarningText (NoToolFound toolName pkgName) = "No packages found in snapshot which provide a " <> T.pack (show toolName) <> " executable, which is a build-tool dependency of " <> T.pack (show (packageNameString pkgName)) toolWarningText (AmbiguousToolsFound toolName pkgName options) = "Multiple packages found in snapshot which provide a " <> T.pack (show toolName) <> " exeuctable, which is a build-tool dependency of " <> T.pack (show (packageNameString pkgName)) <> ", so none will be installed.\n" <> "Here's the list of packages which provide it: " <> T.intercalate ", " (map packageNameText options) <> "\nSince there's no good way to choose, you may need to install it manually." -- | Strip out anything from the @Plan@ intended for the local database stripLocals :: Plan -> Plan stripLocals plan = plan { planTasks = Map.filter checkTask $ planTasks plan , planFinals = Map.empty , planUnregisterLocal = Map.empty , planInstallExes = Map.filter (/= Local) $ planInstallExes plan } where checkTask task = case taskType task of TTLocal _ -> False TTUpstream _ Local _ -> False TTUpstream _ Snap _ -> True stripNonDeps :: Set PackageName -> Plan -> Plan stripNonDeps deps plan = plan { planTasks = Map.filter checkTask $ planTasks plan , planFinals = Map.empty , planInstallExes = Map.empty -- TODO maybe don't disable this? } where checkTask task = packageIdentifierName (taskProvides task) `Set.member` deps markAsDep :: PackageName -> M () markAsDep name = tell mempty { wDeps = Set.singleton name } -- | Is the given package/version combo defined in the snapshot? inSnapshot :: PackageName -> Version -> M Bool inSnapshot name version = do p <- asks mbp ls <- asks localNames return $ fromMaybe False $ do guard $ not $ name `Set.member` ls mpi <- Map.lookup name (mbpPackages p) return $ mpiVersion mpi == version stack-1.1.2/src/Stack/Build/Execute.hs0000644000000000000000000020610512717707440015654 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -- | Perform a build module Stack.Build.Execute ( printPlan , preFetch , executePlan -- * Running Setup.hs , ExecuteEnv , withExecuteEnv , withSingleContext ) where import Control.Applicative import Control.Arrow ((&&&), second) import Control.Concurrent.Execute import Control.Concurrent.MVar.Lifted import Control.Concurrent.STM import Control.Exception.Enclosed (catchIO) import Control.Exception.Lifted import Control.Monad (liftM, when, unless, void) import Control.Monad.Catch (MonadCatch, MonadMask) import Control.Monad.Extra (anyM, (&&^)) import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Trans.Control (liftBaseWith) import Control.Monad.Trans.Resource import Data.Attoparsec.Text hiding (try) import qualified Data.ByteString as S import Data.Char (isSpace) import Data.Conduit import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import qualified Data.Conduit.Text as CT import Data.Either (isRight) import Data.Foldable (forM_, any) import Data.Function import Data.IORef.RunOnce (runOnce) import Data.List hiding (any) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe import Data.Maybe.Extra (forMaybeM) import Data.Monoid ((<>)) import Data.Set (Set) import qualified Data.Set as Set import Data.Streaming.Process hiding (callProcess, env) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) import Data.Time.Clock (getCurrentTime) import Data.Traversable (forM) import Data.Tuple import qualified Distribution.PackageDescription as C import Distribution.System (OS (Windows), Platform (Platform)) import Language.Haskell.TH as TH (location) import Network.HTTP.Client.Conduit (HasHttpManager) import Path import Path.Extra (toFilePathNoTrailingSep, rejectMissingFile) import Path.IO hiding (findExecutable, makeAbsolute) import Prelude hiding (FilePath, writeFile, any) import Stack.Build.Cache import Stack.Build.Haddock import Stack.Build.Installed import Stack.Build.Source import Stack.Build.Target import Stack.Config import Stack.Constants import Stack.Coverage import Stack.Fetch as Fetch import Stack.GhcPkg import Stack.Package import Stack.PackageDump import Stack.Types import Stack.Types.Internal import Stack.Types.StackT import qualified System.Directory as D import System.Environment (getExecutablePath) import System.Exit (ExitCode (ExitSuccess)) import qualified System.FilePath as FP import System.IO import System.PosixCompat.Files (createLink) import System.Process.Log (showProcessArgDebug) import System.Process.Read import System.Process.Run #if !MIN_VERSION_process(1,2,1) import System.Process.Internals (createProcess_) #endif type M env m = (MonadIO m,MonadReader env m,HasHttpManager env,HasBuildConfig env,MonadLogger m,MonadBaseControl IO m,MonadMask m,HasLogLevel env,HasEnvConfig env,HasTerminal env, HasConfig env) -- | Fetch the packages necessary for a build, for example in combination with a dry run. preFetch :: M env m => Plan -> m () preFetch plan | Set.null idents = $logDebug "Nothing to fetch" | otherwise = do $logDebug $ T.pack $ "Prefetching: " ++ intercalate ", " (map packageIdentifierString $ Set.toList idents) menv <- getMinimalEnvOverride fetchPackages menv idents where idents = Set.unions $ map toIdent $ Map.toList $ planTasks plan toIdent (name, task) = case taskType task of TTLocal _ -> Set.empty TTUpstream package _ _ -> Set.singleton $ PackageIdentifier name (packageVersion package) -- | Print a description of build plan for human consumption. printPlan :: M env m => Plan -> m () printPlan plan = do case Map.elems $ planUnregisterLocal plan of [] -> $logInfo "No packages would be unregistered." xs -> do $logInfo "Would unregister locally:" forM_ xs $ \(ident, mreason) -> $logInfo $ T.concat [ T.pack $ packageIdentifierString ident , case mreason of Nothing -> "" Just reason -> T.concat [ " (" , reason , ")" ] ] $logInfo "" case Map.elems $ planTasks plan of [] -> $logInfo "Nothing to build." xs -> do $logInfo "Would build:" mapM_ ($logInfo . displayTask) xs let hasTests = not . Set.null . testComponents . taskComponents hasBenches = not . Set.null . benchComponents . taskComponents tests = Map.elems $ Map.filter hasTests $ planFinals plan benches = Map.elems $ Map.filter hasBenches $ planFinals plan unless (null tests) $ do $logInfo "" $logInfo "Would test:" mapM_ ($logInfo . displayTask) tests unless (null benches) $ do $logInfo "" $logInfo "Would benchmark:" mapM_ ($logInfo . displayTask) benches $logInfo "" case Map.toList $ planInstallExes plan of [] -> $logInfo "No executables to be installed." xs -> do $logInfo "Would install executables:" forM_ xs $ \(name, loc) -> $logInfo $ T.concat [ name , " from " , case loc of Snap -> "snapshot" Local -> "local" , " database" ] -- | For a dry run displayTask :: Task -> Text displayTask task = T.pack $ concat [ packageIdentifierString $ taskProvides task , ": database=" , case taskLocation task of Snap -> "snapshot" Local -> "local" , ", source=" , case taskType task of TTLocal lp -> concat [ toFilePath $ lpDir lp ] TTUpstream _ _ _ -> "package index" , if Set.null missing then "" else ", after: " ++ intercalate "," (map packageIdentifierString $ Set.toList missing) ] where missing = tcoMissing $ taskConfigOpts task data ExecuteEnv = ExecuteEnv { eeEnvOverride :: !EnvOverride , eeConfigureLock :: !(MVar ()) , eeInstallLock :: !(MVar ()) , eeBuildOpts :: !BuildOpts , eeBuildOptsCLI :: !BuildOptsCLI , eeBaseConfigOpts :: !BaseConfigOpts , eeGhcPkgIds :: !(TVar (Map PackageIdentifier Installed)) , eeTempDir :: !(Path Abs Dir) , eeSetupHs :: !(Path Abs File) -- ^ Temporary Setup.hs for simple builds , eeSetupExe :: !(Maybe (Path Abs File)) -- ^ Compiled version of eeSetupHs , eeCabalPkgVer :: !Version , eeTotalWanted :: !Int , eeWanted :: !(Set PackageName) , eeLocals :: ![LocalPackage] , eeGlobalDB :: !(Path Abs Dir) , eeGlobalDumpPkgs :: !(Map GhcPkgId (DumpPackage () ())) , eeSnapshotDumpPkgs :: !(TVar (Map GhcPkgId (DumpPackage () ()))) , eeLocalDumpPkgs :: !(TVar (Map GhcPkgId (DumpPackage () ()))) } -- | Get a compiled Setup exe getSetupExe :: M env m => Path Abs File -- ^ Setup.hs input file -> Path Abs Dir -- ^ temporary directory -> m (Maybe (Path Abs File)) getSetupExe setupHs tmpdir = do wc <- getWhichCompiler econfig <- asks getEnvConfig platformDir <- platformGhcRelDir let config = getConfig econfig baseNameS = concat [ "setup-Simple-Cabal-" , versionString $ envConfigCabalVersion econfig , "-" , compilerVersionString $ envConfigCompilerVersion econfig ] exeNameS = baseNameS ++ case configPlatform config of Platform _ Windows -> ".exe" _ -> "" outputNameS = case wc of Ghc -> exeNameS Ghcjs -> baseNameS ++ ".jsexe" jsExeNameS = baseNameS ++ ".jsexe" setupDir = configStackRoot config $(mkRelDir "setup-exe-cache") platformDir exePath <- fmap (setupDir ) $ parseRelFile exeNameS jsExePath <- fmap (setupDir ) $ parseRelDir jsExeNameS exists <- liftIO $ D.doesFileExist $ toFilePath exePath if exists then return $ Just exePath else do tmpExePath <- fmap (setupDir ) $ parseRelFile $ "tmp-" ++ exeNameS tmpOutputPath <- fmap (setupDir ) $ parseRelFile $ "tmp-" ++ outputNameS tmpJsExePath <- fmap (setupDir ) $ parseRelDir $ "tmp-" ++ jsExeNameS liftIO $ D.createDirectoryIfMissing True $ toFilePath setupDir menv <- getMinimalEnvOverride let args = [ "-clear-package-db" , "-global-package-db" , "-hide-all-packages" , "-package" , "base" , "-package" , "Cabal-" ++ versionString (envConfigCabalVersion econfig) , toFilePath setupHs , "-o" , toFilePath tmpOutputPath , "-rtsopts" ] ++ ["-build-runner" | wc == Ghcjs] runCmd' (\cp -> cp { std_out = UseHandle stderr }) (Cmd (Just tmpdir) (compilerExeName wc) menv args) Nothing when (wc == Ghcjs) $ renameDir tmpJsExePath jsExePath renameFile tmpExePath exePath return $ Just exePath -- | Execute a callback that takes an 'ExecuteEnv'. withExecuteEnv :: M env m => EnvOverride -> BuildOpts -> BuildOptsCLI -> BaseConfigOpts -> [LocalPackage] -> [DumpPackage () ()] -- ^ global packages -> [DumpPackage () ()] -- ^ snapshot packages -> [DumpPackage () ()] -- ^ local packages -> (ExecuteEnv -> m a) -> m a withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages inner = do withSystemTempDir stackProgName $ \tmpdir -> do configLock <- newMVar () installLock <- newMVar () idMap <- liftIO $ newTVarIO Map.empty let setupHs = tmpdir $(mkRelFile "Setup.hs") liftIO $ writeFile (toFilePath setupHs) "import Distribution.Simple\nmain = defaultMain" setupExe <- getSetupExe setupHs tmpdir cabalPkgVer <- asks (envConfigCabalVersion . getEnvConfig) globalDB <- getGlobalDB menv =<< getWhichCompiler snapshotPackagesTVar <- liftIO $ newTVarIO (toDumpPackagesByGhcPkgId snapshotPackages) localPackagesTVar <- liftIO $ newTVarIO (toDumpPackagesByGhcPkgId localPackages) inner ExecuteEnv { eeEnvOverride = menv , eeBuildOpts = bopts , eeBuildOptsCLI = boptsCli -- Uncertain as to why we cannot run configures in parallel. This appears -- to be a Cabal library bug. Original issue: -- https://github.com/fpco/stack/issues/84. Ideally we'd be able to remove -- this. , eeConfigureLock = configLock , eeInstallLock = installLock , eeBaseConfigOpts = baseConfigOpts , eeGhcPkgIds = idMap , eeTempDir = tmpdir , eeSetupHs = setupHs , eeSetupExe = setupExe , eeCabalPkgVer = cabalPkgVer , eeTotalWanted = length $ filter lpWanted locals , eeWanted = wantedLocalPackages locals , eeLocals = locals , eeGlobalDB = globalDB , eeGlobalDumpPkgs = toDumpPackagesByGhcPkgId globalPackages , eeSnapshotDumpPkgs = snapshotPackagesTVar , eeLocalDumpPkgs = localPackagesTVar } where toDumpPackagesByGhcPkgId = Map.fromList . map (\dp -> (dpGhcPkgId dp, dp)) -- | Perform the actual plan executePlan :: M env m => EnvOverride -> BuildOptsCLI -> BaseConfigOpts -> [LocalPackage] -> [DumpPackage () ()] -- ^ global packages -> [DumpPackage () ()] -- ^ snapshot packages -> [DumpPackage () ()] -- ^ local packages -> InstalledMap -> Map PackageName SimpleTarget -> Plan -> m () executePlan menv boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages installedMap targets plan = do bopts <- asks (configBuild . getConfig) withExecuteEnv menv bopts boptsCli baseConfigOpts locals globalPackages snapshotPackages localPackages (executePlan' installedMap targets plan) unless (Map.null $ planInstallExes plan) $ do snapBin <- ( bindirSuffix) `liftM` installationRootDeps localBin <- ( bindirSuffix) `liftM` installationRootLocal destDir <- asks $ configLocalBin . getConfig ensureDir destDir destDir' <- liftIO . D.canonicalizePath . toFilePath $ destDir platform <- asks getPlatform let ext = case platform of Platform _ Windows -> ".exe" _ -> "" currExe <- liftIO getExecutablePath -- needed for windows, see below installed <- forMaybeM (Map.toList $ planInstallExes plan) $ \(name, loc) -> do let bindir = case loc of Snap -> snapBin Local -> localBin mfp <- forgivingAbsence (resolveFile bindir $ T.unpack name ++ ext) >>= rejectMissingFile case mfp of Nothing -> do $logWarn $ T.concat [ "Couldn't find executable " , name , " in directory " , T.pack $ toFilePath bindir ] return Nothing Just file -> do let destFile = destDir' FP. T.unpack name ++ ext $logInfo $ T.concat [ "Copying from " , T.pack $ toFilePath file , " to " , T.pack destFile ] liftIO $ case platform of Platform _ Windows | FP.equalFilePath destFile currExe -> windowsRenameCopy (toFilePath file) destFile _ -> D.copyFile (toFilePath file) destFile return $ Just (name <> T.pack ext) unless (null installed) $ do $logInfo "" $logInfo $ T.concat [ "Copied executables to " , T.pack destDir' , ":"] forM_ installed $ \exe -> $logInfo ("- " <> exe) searchPath <- liftIO FP.getSearchPath destDirIsInPATH <- liftIO $ anyM (\dir -> D.doesDirectoryExist dir &&^ fmap (FP.equalFilePath destDir') (D.canonicalizePath dir)) searchPath if destDirIsInPATH then forM_ installed $ \exe -> do mexePath <- (liftIO . D.findExecutable . T.unpack) exe case mexePath of Just exePath -> do exeDir <- (liftIO . fmap FP.takeDirectory . D.canonicalizePath) exePath unless (exeDir `FP.equalFilePath` destDir') $ do $logWarn "" $logWarn $ T.concat [ "WARNING: The \"" , exe , "\" executable found on the PATH environment variable is " , T.pack exePath , ", and not the version that was just installed." ] $logWarn $ T.concat [ "This means that \"" , exe , "\" calls on the command line will not use this version." ] Nothing -> do $logWarn "" $logWarn $ T.concat [ "WARNING: Installation path " , T.pack destDir' , " is on the PATH but the \"" , exe , "\" executable that was just installed could not be found on the PATH." ] else do $logWarn "" $logWarn $ T.concat [ "WARNING: Installation path " , T.pack destDir' , " not found on the PATH environment variable" ] config <- asks getConfig menv' <- liftIO $ configEnvOverride config EnvSettings { esIncludeLocals = True , esIncludeGhcPackagePath = True , esStackExe = True , esLocaleUtf8 = False } forM_ (boptsCLIExec boptsCli) $ \(cmd, args) -> do $logProcessRun cmd args callProcess (Cmd Nothing cmd menv' args) -- | Windows can't write over the current executable. Instead, we rename the -- current executable to something else and then do the copy. windowsRenameCopy :: FilePath -> FilePath -> IO () windowsRenameCopy src dest = do D.copyFile src new D.renameFile dest old D.renameFile new dest where new = dest ++ ".new" old = dest ++ ".old" -- | Perform the actual plan (internal) executePlan' :: M env m => InstalledMap -> Map PackageName SimpleTarget -> Plan -> ExecuteEnv -> m () executePlan' installedMap0 targets plan ee@ExecuteEnv {..} = do when (toCoverage $ boptsTestOpts eeBuildOpts) deleteHpcReports wc <- getWhichCompiler cv <- asks $ envConfigCompilerVersion . getEnvConfig case Map.toList $ planUnregisterLocal plan of [] -> return () ids -> do localDB <- packageDatabaseLocal forM_ ids $ \(id', (ident, mreason)) -> do $logInfo $ T.concat [ T.pack $ packageIdentifierString ident , ": unregistering" , case mreason of Nothing -> "" Just reason -> T.concat [ " (" , reason , ")" ] ] unregisterGhcPkgId eeEnvOverride wc cv localDB id' ident liftIO $ atomically $ modifyTVar' eeLocalDumpPkgs $ \initMap -> foldl' (flip Map.delete) initMap $ Map.keys (planUnregisterLocal plan) -- Yes, we're explicitly discarding result values, which in general would -- be bad. monad-unlift does this all properly at the type system level, -- but I don't want to pull it in for this one use case, when we know that -- stack always using transformer stacks that are safe for this use case. runInBase <- liftBaseWith $ \run -> return (void . run) let actions = concatMap (toActions installedMap' runInBase ee) $ Map.elems $ Map.mergeWithKey (\_ b f -> Just (Just b, Just f)) (fmap (\b -> (Just b, Nothing))) (fmap (\f -> (Nothing, Just f))) (planTasks plan) (planFinals plan) threads <- asks $ configJobs . getConfig concurrentTests <- asks $ configConcurrentTests . getConfig let keepGoing = case boptsKeepGoing eeBuildOpts of Just kg -> kg Nothing -> boptsTests eeBuildOpts || boptsBenchmarks eeBuildOpts concurrentFinal = -- TODO it probably makes more sense to use a lock for test suites -- and just have the execution blocked. Turning off all concurrency -- on finals based on the --test option doesn't fit in well. if boptsTests eeBuildOpts then concurrentTests else True terminal <- asks getTerminal errs <- liftIO $ runActions threads keepGoing concurrentFinal actions $ \doneVar -> do let total = length actions loop prev | prev == total = runInBase $ $logStickyDone ("Completed " <> T.pack (show total) <> " action(s).") | otherwise = do when terminal $ runInBase $ $logSticky ("Progress: " <> T.pack (show prev) <> "/" <> T.pack (show total)) done <- atomically $ do done <- readTVar doneVar check $ done /= prev return done loop done if total > 1 then loop 0 else return () when (toCoverage $ boptsTestOpts eeBuildOpts) $ do generateHpcUnifiedReport generateHpcMarkupIndex unless (null errs) $ throwM $ ExecutionFailure errs when (boptsHaddock eeBuildOpts) $ do snapshotDumpPkgs <- liftIO (readTVarIO eeSnapshotDumpPkgs) localDumpPkgs <- liftIO (readTVarIO eeLocalDumpPkgs) generateLocalHaddockIndex eeEnvOverride wc eeBaseConfigOpts localDumpPkgs eeLocals generateDepsHaddockIndex eeEnvOverride wc eeBaseConfigOpts eeGlobalDumpPkgs snapshotDumpPkgs localDumpPkgs eeLocals generateSnapHaddockIndex eeEnvOverride wc eeBaseConfigOpts eeGlobalDumpPkgs snapshotDumpPkgs when (boptsOpenHaddocks eeBuildOpts) $ do let planPkgs, localPkgs, installedPkgs, availablePkgs :: Map PackageName (PackageIdentifier, InstallLocation) planPkgs = Map.map (taskProvides &&& taskLocation) (planTasks plan) localPkgs = Map.fromList [(packageName p, (packageIdentifier p, Local)) | p <- map lpPackage eeLocals] installedPkgs = Map.map (swap . second installedPackageIdentifier) installedMap' availablePkgs = Map.unions [planPkgs, localPkgs, installedPkgs] openHaddocksInBrowser eeBaseConfigOpts availablePkgs (Map.keysSet targets) where installedMap' = Map.difference installedMap0 $ Map.fromList $ map (\(ident, _) -> (packageIdentifierName ident, ())) $ Map.elems $ planUnregisterLocal plan toActions :: M env m => InstalledMap -> (m () -> IO ()) -> ExecuteEnv -> (Maybe Task, Maybe Task) -- build and final -> [Action] toActions installedMap runInBase ee (mbuild, mfinal) = abuild ++ afinal where abuild = case mbuild of Nothing -> [] Just task@Task {..} -> [ Action { actionId = ActionId taskProvides ATBuild , actionDeps = (Set.map (\ident -> ActionId ident ATBuild) (tcoMissing taskConfigOpts)) , actionDo = \ac -> runInBase $ singleBuild runInBase ac ee task installedMap False } ] afinal = case mfinal of Nothing -> [] Just task@Task {..} -> (if taskAllInOne then [] else [Action { actionId = ActionId taskProvides ATBuildFinal , actionDeps = addBuild ATBuild (Set.map (\ident -> ActionId ident ATBuild) (tcoMissing taskConfigOpts)) , actionDo = \ac -> runInBase $ singleBuild runInBase ac ee task installedMap True }]) ++ [ Action { actionId = ActionId taskProvides ATFinal , actionDeps = addBuild (if taskAllInOne then ATBuild else ATBuildFinal) Set.empty , actionDo = \ac -> runInBase $ do let comps = taskComponents task tests = testComponents comps benches = benchComponents comps unless (Set.null tests) $ do singleTest runInBase topts (Set.toList tests) ac ee task installedMap unless (Set.null benches) $ do singleBench runInBase beopts (Set.toList benches) ac ee task installedMap } ] where addBuild aty = case mbuild of Nothing -> id Just _ -> Set.insert $ ActionId taskProvides aty bopts = eeBuildOpts ee topts = boptsTestOpts bopts beopts = boptsBenchmarkOpts bopts -- | Generate the ConfigCache getConfigCache :: M env m => ExecuteEnv -> Task -> InstalledMap -> Bool -> Bool -> m (Map PackageIdentifier GhcPkgId, ConfigCache) getConfigCache ExecuteEnv {..} Task {..} installedMap enableTest enableBench = do useExactConf <- asks (configAllowNewer . getConfig) let extra = -- We enable tests if the test suite dependencies are already -- installed, so that we avoid unnecessary recompilation based on -- cabal_macros.h changes when switching between 'stack build' and -- 'stack test'. See: -- https://github.com/commercialhaskell/stack/issues/805 case taskType of TTLocal lp -> concat -- FIXME: make this work with exact-configuration. -- Not sure how to plumb the info atm. See -- https://github.com/commercialhaskell/stack/issues/2049 [ [ "--enable-tests" | enableTest || (not useExactConf && depsPresent installedMap (lpTestDeps lp))] , [ "--enable-benchmarks" | enableBench || (not useExactConf && depsPresent installedMap (lpBenchDeps lp))] ] _ -> [] idMap <- liftIO $ readTVarIO eeGhcPkgIds let getMissing ident = case Map.lookup ident idMap of Nothing -> error "singleBuild: invariant violated, missing package ID missing" Just (Library ident' x) -> assert (ident == ident') $ Just (ident, x) Just (Executable _) -> Nothing missing' = Map.fromList $ mapMaybe getMissing $ Set.toList missing TaskConfigOpts missing mkOpts = taskConfigOpts opts = mkOpts missing' allDeps = Set.fromList $ Map.elems missing' ++ Map.elems taskPresent cache = ConfigCache { configCacheOpts = opts { coNoDirs = coNoDirs opts ++ map T.unpack extra } , configCacheDeps = allDeps , configCacheComponents = case taskType of TTLocal lp -> Set.map renderComponent $ lpComponents lp TTUpstream _ _ _ -> Set.empty , configCacheHaddock = shouldHaddockPackage eeBuildOpts eeWanted (packageIdentifierName taskProvides) } allDepsMap = Map.union missing' taskPresent return (allDepsMap, cache) -- | Ensure that the configuration for the package matches what is given ensureConfig :: M env m => ConfigCache -- ^ newConfigCache -> Path Abs Dir -- ^ package directory -> ExecuteEnv -> m () -- ^ announce -> (Bool -> [String] -> m ()) -- ^ cabal -> Path Abs File -- ^ .cabal file -> m Bool ensureConfig newConfigCache pkgDir ExecuteEnv {..} announce cabal cabalfp = do newCabalMod <- liftIO (fmap modTime (D.getModificationTime (toFilePath cabalfp))) needConfig <- if boptsReconfigure eeBuildOpts then return True else do -- We can ignore the components portion of the config -- cache, because it's just used to inform 'construct -- plan that we need to plan to build additional -- components. These components don't affect the actual -- package configuration. let ignoreComponents cc = cc { configCacheComponents = Set.empty } -- Determine the old and new configuration in the local directory, to -- determine if we need to reconfigure. mOldConfigCache <- tryGetConfigCache pkgDir mOldCabalMod <- tryGetCabalMod pkgDir return $ fmap ignoreComponents mOldConfigCache /= Just (ignoreComponents newConfigCache) || mOldCabalMod /= Just newCabalMod let ConfigureOpts dirs nodirs = configCacheOpts newConfigCache when needConfig $ withMVar eeConfigureLock $ \_ -> do deleteCaches pkgDir announce menv <- getMinimalEnvOverride let programNames = if eeCabalPkgVer < $(mkVersion "1.22") then ["ghc", "ghc-pkg"] else ["ghc", "ghc-pkg", "ghcjs", "ghcjs-pkg"] exes <- forM programNames $ \name -> do mpath <- findExecutable menv name return $ case mpath of Nothing -> [] Just x -> return $ concat ["--with-", name, "=", toFilePath x] -- Configure cabal with arguments determined by -- Stack.Types.Build.configureOpts cabal False $ "configure" : concat [ concat exes , dirs , nodirs ] writeConfigCache pkgDir newConfigCache writeCabalMod pkgDir newCabalMod return needConfig announceTask :: MonadLogger m => Task -> Text -> m () announceTask task x = $logInfo $ T.concat [ T.pack $ packageIdentifierString $ taskProvides task , ": " , x ] withSingleContext :: M env m => (m () -> IO ()) -> ActionContext -> ExecuteEnv -> Task -> Maybe (Map PackageIdentifier GhcPkgId) -- ^ All dependencies' package ids to provide to Setup.hs. If -- Nothing, just provide global and snapshot package -- databases. -> Maybe String -> ( Package -> Path Abs File -> Path Abs Dir -> (Bool -> [String] -> m ()) -> (Text -> m ()) -> Bool -> Maybe (Path Abs File, Handle) -> m a) -> m a withSingleContext runInBase ActionContext {..} ExecuteEnv {..} task@Task {..} mdeps msuffix inner0 = withPackage $ \package cabalfp pkgDir -> withLogFile package $ \mlogFile -> withCabal package pkgDir mlogFile $ \cabal -> inner0 package cabalfp pkgDir cabal announce console mlogFile where announce = announceTask task wanted = case taskType of TTLocal lp -> lpWanted lp TTUpstream _ _ _ -> False console = wanted && all (\(ActionId ident _) -> ident == taskProvides) (Set.toList acRemaining) && eeTotalWanted == 1 withPackage inner = case taskType of TTLocal lp -> inner (lpPackage lp) (lpCabalFile lp) (lpDir lp) TTUpstream package _ gitSHA1 -> do mdist <- liftM Just distRelativeDir m <- unpackPackageIdents eeEnvOverride eeTempDir mdist $ Map.singleton taskProvides gitSHA1 case Map.toList m of [(ident, dir)] | ident == taskProvides -> do let name = packageIdentifierName taskProvides cabalfpRel <- parseRelFile $ packageNameString name ++ ".cabal" let cabalfp = dir cabalfpRel inner package cabalfp dir _ -> error $ "withPackage: invariant violated: " ++ show m withLogFile package inner | console = inner Nothing | otherwise = do logPath <- buildLogPath package msuffix ensureDir (parent logPath) let fp = toFilePath logPath bracket (liftIO $ openBinaryFile fp WriteMode) (liftIO . hClose) $ \h -> inner (Just (logPath, h)) withCabal package pkgDir mlogFile inner = do config <- asks getConfig unless (configAllowDifferentUser config) $ checkOwnership (pkgDir configWorkDir config) let envSettings = EnvSettings { esIncludeLocals = taskLocation task == Local , esIncludeGhcPackagePath = False , esStackExe = False , esLocaleUtf8 = True } menv <- liftIO $ configEnvOverride config envSettings getGhcPath <- runOnce $ getCompilerPath Ghc getGhcjsPath <- runOnce $ getCompilerPath Ghcjs distRelativeDir' <- distRelativeDir esetupexehs <- -- Avoid broken Setup.hs files causing problems for simple build -- types, see: -- https://github.com/commercialhaskell/stack/issues/370 case (packageSimpleType package, eeSetupExe) of (True, Just setupExe) -> return $ Left setupExe _ -> liftIO $ fmap Right $ getSetupHs pkgDir inner $ \stripTHLoading args -> do let cabalPackageArg -- Omit cabal package dependency when building -- Cabal. See -- https://github.com/commercialhaskell/stack/issues/1356 | packageName package == $(mkPackageName "Cabal") = [] | otherwise = ["-package=" ++ packageIdentifierString (PackageIdentifier cabalPackageName eeCabalPkgVer)] packageArgs = case mdeps of -- This branch is taken when -- 'explicit-setup-deps' is requested in your -- stack.yaml file. Just deps | explicitSetupDeps (packageName package) config -> -- Stack always builds with the global Cabal for various -- reproducibility issues. let depsMinusCabal = map ghcPkgIdString $ Set.toList $ addGlobalPackages deps (Map.elems eeGlobalDumpPkgs) in ( "-clear-package-db" : "-global-package-db" : map (("-package-db=" ++) . toFilePathNoTrailingSep) (bcoExtraDBs eeBaseConfigOpts) ) ++ ( ("-package-db=" ++ toFilePathNoTrailingSep (bcoSnapDB eeBaseConfigOpts)) : ("-package-db=" ++ toFilePathNoTrailingSep (bcoLocalDB eeBaseConfigOpts)) : ["-hide-all-packages"] ) ++ cabalPackageArg ++ map ("-package-id=" ++) depsMinusCabal -- This branch is usually taken for builds, and -- is always taken for `stack sdist`. -- -- This approach is debatable. It adds access to the -- snapshot package database for Cabal. There are two -- possible objections: -- -- 1. This doesn't isolate the build enough; arbitrary -- other packages available could cause the build to -- succeed or fail. -- -- 2. This doesn't provide enough packages: we should also -- include the local database when building local packages. -- -- Currently, this branch is only taken via `stack -- sdist` or when explicitly requested in the -- stack.yaml file. _ -> cabalPackageArg ++ ("-clear-package-db" : "-global-package-db" : map (("-package-db=" ++) . toFilePathNoTrailingSep) (bcoExtraDBs eeBaseConfigOpts) ++ ["-package-db=" ++ toFilePathNoTrailingSep (bcoSnapDB eeBaseConfigOpts)]) setupArgs = ("--builddir=" ++ toFilePathNoTrailingSep distRelativeDir') : args runExe exeName fullArgs = runAndOutput `catch` \(ProcessExitedUnsuccessfully _ ec) -> do bss <- case mlogFile of Nothing -> return [] Just (logFile, h) -> do liftIO $ hClose h runResourceT $ CB.sourceFile (toFilePath logFile) =$= CT.decodeUtf8Lenient $$ mungeBuildOutput stripTHLoading makeAbsolute pkgDir =$ CL.consume throwM $ CabalExitedUnsuccessfully ec taskProvides exeName fullArgs (fmap fst mlogFile) bss where runAndOutput = case mlogFile of Just (_, h) -> sinkProcessStderrStdoutHandle (Just pkgDir) menv (toFilePath exeName) fullArgs h h Nothing -> void $ sinkProcessStderrStdout (Just pkgDir) menv (toFilePath exeName) fullArgs (outputSink False LevelWarn) (outputSink stripTHLoading LevelInfo) outputSink excludeTH level = CT.decodeUtf8Lenient =$ mungeBuildOutput excludeTH makeAbsolute pkgDir =$ CL.mapM_ (runInBase . monadLoggerLog $(TH.location >>= liftLoc) "" level) -- If users want control, we should add a config option for this makeAbsolute = stripTHLoading wc <- getWhichCompiler (exeName, fullArgs) <- case (esetupexehs, wc) of (Left setupExe, _) -> return (setupExe, setupArgs) (Right setuphs, compiler) -> do distDir <- distDirFromDir pkgDir let setupDir = distDir $(mkRelDir "setup") outputFile = setupDir $(mkRelFile "setup") ensureDir setupDir compilerPath <- case compiler of Ghc -> getGhcPath Ghcjs -> getGhcjsPath runExe compilerPath $ [ "--make" , "-odir", toFilePathNoTrailingSep setupDir , "-hidir", toFilePathNoTrailingSep setupDir , "-i", "-i." ] ++ packageArgs ++ [ toFilePath setuphs , "-o", toFilePath outputFile ] ++ (case compiler of Ghc -> [] Ghcjs -> ["-build-runner"]) return (outputFile, setupArgs) runExe exeName $ (if boptsCabalVerbose eeBuildOpts then ("--verbose":) else id) fullArgs singleBuild :: M env m => (m () -> IO ()) -> ActionContext -> ExecuteEnv -> Task -> InstalledMap -> Bool -- ^ Is this a final build? -> m () singleBuild runInBase ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap isFinalBuild = do (allDepsMap, cache) <- getConfigCache ee task installedMap enableTests enableBenchmarks mprecompiled <- getPrecompiled cache minstalled <- case mprecompiled of Just precompiled -> copyPreCompiled precompiled Nothing -> realConfigAndBuild cache allDepsMap case minstalled of Nothing -> return () Just installed -> do writeFlagCache installed cache liftIO $ atomically $ modifyTVar eeGhcPkgIds $ Map.insert taskProvides installed where pname = packageIdentifierName taskProvides shouldHaddockPackage' = shouldHaddockPackage eeBuildOpts eeWanted pname doHaddock package = shouldHaddockPackage' && not isFinalBuild && -- Works around haddock failing on bytestring-builder since it has no modules -- when bytestring is new enough. packageHasExposedModules package buildingFinals = isFinalBuild || taskAllInOne enableTests = buildingFinals && any isCTest (taskComponents task) enableBenchmarks = buildingFinals && any isCBench (taskComponents task) annSuffix = if result == "" then "" else " (" <> result <> ")" where result = T.intercalate " + " $ concat $ [ ["lib" | taskAllInOne && hasLib] , ["exe" | taskAllInOne && hasExe] , ["test" | enableTests] , ["bench" | enableBenchmarks] ] (hasLib, hasExe) = case taskType of TTLocal lp -> (packageHasLibrary (lpPackage lp), not (Set.null (exesToBuild lp))) -- This isn't true, but we don't want to have this info for -- upstream deps. TTUpstream{} -> (False, False) getPrecompiled cache = case taskLocation task of Snap | not shouldHaddockPackage' -> do mpc <- readPrecompiledCache taskProvides (configCacheOpts cache) (configCacheDeps cache) case mpc of Nothing -> return Nothing -- Only pay attention to precompiled caches that refer to packages within -- the snapshot. Just pc | maybe False (bcoSnapInstallRoot eeBaseConfigOpts `isParentOf`) (parseAbsFile =<< (pcLibrary pc)) -> return Nothing -- If old precompiled cache files are left around but snapshots are deleted, -- it is possible for the precompiled file to refer to the very library -- we're building, and if flags are changed it may try to copy the library -- to itself. This check prevents that from happening. Just pc | otherwise -> do let allM _ [] = return True allM f (x:xs) = do b <- f x if b then allM f xs else return False b <- liftIO $ allM D.doesFileExist $ maybe id (:) (pcLibrary pc) $ pcExes pc return $ if b then Just pc else Nothing _ -> return Nothing copyPreCompiled (PrecompiledCache mlib exes) = do wc <- getWhichCompiler announceTask task "using precompiled package" forM_ mlib $ \libpath -> do menv <- getMinimalEnvOverride withMVar eeInstallLock $ \() -> do -- We want to ignore the global and user databases. -- Unfortunately, ghc-pkg doesn't take such arguments on the -- command line. Instead, we'll set GHC_PACKAGE_PATH. See: -- https://github.com/commercialhaskell/stack/issues/1146 menv' <- modifyEnvOverride menv $ Map.insert "GHC_PACKAGE_PATH" (T.pack $ toFilePathNoTrailingSep $ bcoSnapDB eeBaseConfigOpts) -- In case a build of the library with different flags already exists, unregister it -- before copying. let ghcPkgExe = ghcPkgExeName wc catch (readProcessNull Nothing menv' ghcPkgExe [ "unregister" , "--force" , packageIdentifierString taskProvides ]) (\ex -> case ex of ReadProcessException{} -> return () _ -> throwM ex) readProcessNull Nothing menv' ghcPkgExe [ "register" , "--force" , libpath ] liftIO $ forM_ exes $ \exe -> do D.createDirectoryIfMissing True bindir let dst = bindir FP. FP.takeFileName exe createLink exe dst `catchIO` \_ -> D.copyFile exe dst case (mlib, exes) of (Nothing, _:_) -> markExeInstalled (taskLocation task) taskProvides _ -> return () -- Find the package in the database let pkgDbs = [bcoSnapDB eeBaseConfigOpts] case mlib of Nothing -> return $ Just $ Executable taskProvides Just _ -> do mpkgid <- loadInstalledPkg eeEnvOverride wc pkgDbs eeSnapshotDumpPkgs pname return $ Just $ case mpkgid of Nothing -> assert False $ Executable taskProvides Just pkgid -> Library taskProvides pkgid where bindir = toFilePath $ bcoSnapInstallRoot eeBaseConfigOpts bindirSuffix realConfigAndBuild cache allDepsMap = withSingleContext runInBase ac ee task (Just allDepsMap) Nothing $ \package cabalfp pkgDir cabal announce _console _mlogFile -> do _neededConfig <- ensureConfig cache pkgDir ee (announce ("configure" <> annSuffix)) cabal cabalfp if boptsCLIOnlyConfigure eeBuildOptsCLI then return Nothing else liftM Just $ realBuild cache package pkgDir cabal announce realBuild cache package pkgDir cabal announce = do wc <- getWhichCompiler markExeNotInstalled (taskLocation task) taskProvides case taskType of TTLocal lp -> do when enableTests $ unsetTestSuccess pkgDir writeBuildCache pkgDir $ lpNewBuildCache lp TTUpstream _ _ _ -> return () () <- announce ("build" <> annSuffix) config <- asks getConfig extraOpts <- extraBuildOptions eeBuildOpts preBuildTime <- modTime <$> liftIO getCurrentTime cabal (configHideTHLoading config) $ ("build" :) $ (++ extraOpts) $ case (taskType, taskAllInOne, isFinalBuild) of (_, True, True) -> fail "Invariant violated: cannot have an all-in-one build that also has a final build step." (TTLocal lp, False, False) -> primaryComponentOptions lp (TTLocal lp, False, True) -> finalComponentOptions lp (TTLocal lp, True, False) -> primaryComponentOptions lp ++ finalComponentOptions lp (TTUpstream{}, _, _) -> [] checkForUnlistedFiles taskType preBuildTime pkgDir when (doHaddock package) $ do announce "haddock" sourceFlag <- do hyped <- tryProcessStdout Nothing eeEnvOverride "haddock" ["--hyperlinked-source"] case hyped of -- Fancy crosslinked source Right _ -> do return ["--haddock-option=--hyperlinked-source"] -- Older hscolour colouring Left _ -> do hscolourExists <- doesExecutableExist eeEnvOverride "HsColour" unless hscolourExists $ $logWarn ("Warning: haddock not generating hyperlinked sources because 'HsColour' not\n" <> "found on PATH (use 'stack install hscolour' to install).") return ["--hyperlink-source" | hscolourExists] cabal False (concat [["haddock", "--html", "--hoogle", "--html-location=../$pkg-$version/"] ,sourceFlag]) unless isFinalBuild $ withMVar eeInstallLock $ \() -> do announce "copy/register" eres <- try $ cabal False ["copy"] case eres of Left err@CabalExitedUnsuccessfully{} -> throwM $ CabalCopyFailed (packageSimpleType package) (show err) _ -> return () when (packageHasLibrary package) $ cabal False ["register"] let (installedPkgDb, installedDumpPkgsTVar) = case taskLocation task of Snap -> ( bcoSnapDB eeBaseConfigOpts , eeSnapshotDumpPkgs ) Local -> ( bcoLocalDB eeBaseConfigOpts , eeLocalDumpPkgs ) let ident = PackageIdentifier (packageName package) (packageVersion package) mpkgid <- if packageHasLibrary package then do mpkgid <- loadInstalledPkg eeEnvOverride wc [installedPkgDb] installedDumpPkgsTVar (packageName package) case mpkgid of Nothing -> throwM $ Couldn'tFindPkgId $ packageName package Just pkgid -> return $ Library ident pkgid else do markExeInstalled (taskLocation task) taskProvides -- TODO unify somehow with writeFlagCache? return $ Executable ident case taskLocation task of Snap -> writePrecompiledCache eeBaseConfigOpts taskProvides (configCacheOpts cache) (configCacheDeps cache) mpkgid (packageExes package) Local -> return () return mpkgid loadInstalledPkg menv wc pkgDbs tvar name = do dps <- ghcPkgDescribe name menv wc pkgDbs $ conduitDumpPackage =$ CL.consume case dps of [] -> return Nothing [dp] -> do liftIO $ atomically $ modifyTVar' tvar (Map.insert (dpGhcPkgId dp) dp) return $ Just (dpGhcPkgId dp) _ -> error "singleBuild: invariant violated: multiple results when describing installed package" -- | Check if any unlisted files have been found, and add them to the build cache. checkForUnlistedFiles :: M env m => TaskType -> ModTime -> Path Abs Dir -> m () checkForUnlistedFiles (TTLocal lp) preBuildTime pkgDir = do (addBuildCache,warnings) <- addUnlistedToBuildCache preBuildTime (lpPackage lp) (lpCabalFile lp) (lpNewBuildCache lp) mapM_ ($logWarn . ("Warning: " <>) . T.pack . show) warnings unless (null addBuildCache) $ writeBuildCache pkgDir $ Map.unions (lpNewBuildCache lp : addBuildCache) checkForUnlistedFiles (TTUpstream _ _ _) _ _ = return () -- | Determine if all of the dependencies given are installed depsPresent :: InstalledMap -> Map PackageName VersionRange -> Bool depsPresent installedMap deps = all (\(name, range) -> case Map.lookup name installedMap of Just (_, installed) -> installedVersion installed `withinRange` range Nothing -> False) (Map.toList deps) singleTest :: M env m => (m () -> IO ()) -> TestOpts -> [Text] -> ActionContext -> ExecuteEnv -> Task -> InstalledMap -> m () singleTest runInBase topts testsToRun ac ee task installedMap = do -- FIXME: Since this doesn't use cabal, we should be able to avoid using a -- fullblown 'withSingleContext'. (allDepsMap, _cache) <- getConfigCache ee task installedMap True False withSingleContext runInBase ac ee task (Just allDepsMap) (Just "test") $ \package _cabalfp pkgDir _cabal announce _console mlogFile -> do config <- asks getConfig let needHpc = toCoverage topts toRun <- if toDisableRun topts then do announce "Test running disabled by --no-run-tests flag." return False else if toRerunTests topts then return True else do success <- checkTestSuccess pkgDir if success then do unless (null testsToRun) $ announce "skipping already passed test" return False else return True when toRun $ do buildDir <- distDirFromDir pkgDir hpcDir <- hpcDirFromDir pkgDir when needHpc (ensureDir hpcDir) let suitesToRun = [ testSuitePair | testSuitePair <- Map.toList $ packageTests package , let testName = fst testSuitePair , testName `elem` testsToRun ] errs <- liftM Map.unions $ forM suitesToRun $ \(testName, suiteInterface) -> do let stestName = T.unpack testName (testName', isTestTypeLib) <- case suiteInterface of C.TestSuiteLibV09{} -> return (stestName ++ "Stub", True) C.TestSuiteExeV10{} -> return (stestName, False) interface -> throwM (TestSuiteTypeUnsupported interface) let exeName = testName' ++ case configPlatform config of Platform _ Windows -> ".exe" _ -> "" tixPath <- liftM (pkgDir ) $ parseRelFile $ exeName ++ ".tix" exePath <- liftM (buildDir ) $ parseRelFile $ "build/" ++ testName' ++ "/" ++ exeName exists <- doesFileExist exePath menv <- liftIO $ configEnvOverride config EnvSettings { esIncludeLocals = taskLocation task == Local , esIncludeGhcPackagePath = True , esStackExe = True , esLocaleUtf8 = False } if exists then do -- We clear out the .tix files before doing a run. when needHpc $ do tixexists <- doesFileExist tixPath when tixexists $ $logWarn ("Removing HPC file " <> T.pack (toFilePath tixPath)) ignoringAbsence (removeFile tixPath) let args = toAdditionalArgs topts argsDisplay = case args of [] -> "" _ -> ", args: " <> T.intercalate " " (map showProcessArgDebug args) announce $ "test (suite: " <> testName <> argsDisplay <> ")" -- Clear "Progress: ..." message before -- redirecting output. when (isNothing mlogFile) $ do $logStickyDone "" liftIO $ hFlush stdout liftIO $ hFlush stderr let output = case mlogFile of Nothing -> Inherit Just (_, h) -> UseHandle h -- Use createProcess_ to avoid the log file being closed afterwards (Just inH, Nothing, Nothing, ph) <- createProcess' stestName (\cp -> cp { std_in = CreatePipe, std_out = output, std_err = output }) (Cmd (Just pkgDir) (toFilePath exePath) menv args) when isTestTypeLib $ do logPath <- buildLogPath package (Just stestName) ensureDir (parent logPath) liftIO $ hPutStr inH $ show (logPath, testName) liftIO $ hClose inH ec <- liftIO $ waitForProcess ph -- Add a trailing newline, incase the test -- output didn't finish with a newline. when (isNothing mlogFile) ($logInfo "") -- Move the .tix file out of the package -- directory into the hpc work dir, for -- tidiness. when needHpc $ updateTixFile (packageName package) tixPath testName' return $ case ec of ExitSuccess -> Map.empty _ -> Map.singleton testName $ Just ec else do $logError $ T.pack $ show $ TestSuiteExeMissing (packageSimpleType package) exeName (packageNameString (packageName package)) (T.unpack testName) return $ Map.singleton testName Nothing when needHpc $ do let testsToRun' = map f testsToRun f tName = case Map.lookup tName (packageTests package) of Just C.TestSuiteLibV09{} -> tName <> "Stub" _ -> tName generateHpcReport pkgDir package testsToRun' bs <- liftIO $ case mlogFile of Nothing -> return "" Just (logFile, h) -> do hClose h S.readFile $ toFilePath logFile unless (Map.null errs) $ throwM $ TestSuiteFailure (taskProvides task) errs (fmap fst mlogFile) bs singleBench :: M env m => (m () -> IO ()) -> BenchmarkOpts -> [Text] -> ActionContext -> ExecuteEnv -> Task -> InstalledMap -> m () singleBench runInBase beopts benchesToRun ac ee task installedMap = do (allDepsMap, _cache) <- getConfigCache ee task installedMap False True withSingleContext runInBase ac ee task (Just allDepsMap) (Just "bench") $ \_package _cabalfp _pkgDir cabal announce _console _mlogFile -> do let args = map T.unpack benchesToRun <> maybe [] ((:[]) . ("--benchmark-options=" <>)) (beoAdditionalArgs beopts) toRun <- if beoDisableRun beopts then do announce "Benchmark running disabled by --no-run-benchmarks flag." return False else do return True when toRun $ do announce "benchmarks" cabal False ("bench" : args) -- | Strip Template Haskell "Loading package" lines and making paths absolute. mungeBuildOutput :: (MonadIO m, MonadCatch m) => Bool -- ^ exclude TH loading? -> Bool -- ^ convert paths to absolute? -> Path Abs Dir -- ^ package's root directory -> ConduitM Text Text m () mungeBuildOutput excludeTHLoading makeAbsolute pkgDir = void $ CT.lines =$ CL.map stripCarriageReturn =$ CL.filter (not . isTHLoading) =$ CL.mapM toAbsolutePath where -- | Is this line a Template Haskell "Loading package" line -- ByteString isTHLoading :: Text -> Bool isTHLoading _ | not excludeTHLoading = False isTHLoading bs = "Loading package " `T.isPrefixOf` bs && ("done." `T.isSuffixOf` bs || "done.\r" `T.isSuffixOf` bs) -- | Convert GHC error lines with file paths to have absolute file paths toAbsolutePath bs | not makeAbsolute = return bs toAbsolutePath bs = do let (x, y) = T.break (== ':') bs mabs <- if isValidSuffix y then liftM (fmap ((T.takeWhile isSpace x <>) . T.pack . toFilePath)) $ forgivingAbsence (resolveFile pkgDir (T.unpack $ T.dropWhile isSpace x)) else return Nothing case mabs of Nothing -> return bs Just fp -> return $ fp `T.append` y -- | Match the line:column format at the end of lines isValidSuffix = isRight . parseOnly lineCol lineCol = char ':' >> (decimal :: Parser Int) >> char ':' >> (decimal :: Parser Int) >> char ':' >> return () -- | Strip @\r@ characters from the byte vector. Used because Windows. stripCarriageReturn :: Text -> Text stripCarriageReturn = T.filter (/= '\r') -- | Find the Setup.hs or Setup.lhs in the given directory. If none exists, -- throw an exception. getSetupHs :: Path Abs Dir -- ^ project directory -> IO (Path Abs File) getSetupHs dir = do exists1 <- doesFileExist fp1 if exists1 then return fp1 else do exists2 <- doesFileExist fp2 if exists2 then return fp2 else throwM $ NoSetupHsFound dir where fp1 = dir $(mkRelFile "Setup.hs") fp2 = dir $(mkRelFile "Setup.lhs") -- Do not pass `-hpcdir` as GHC option if the coverage is not enabled. -- This helps running stack-compiled programs with dynamic interpreters like `hint`. -- Cfr: https://github.com/commercialhaskell/stack/issues/997 extraBuildOptions :: M env m => BuildOpts -> m [String] extraBuildOptions bopts = do let ddumpOpts = " -ddump-hi -ddump-to-file" case toCoverage (boptsTestOpts bopts) of True -> do hpcIndexDir <- toFilePathNoTrailingSep <$> hpcRelativeDir return ["--ghc-options", "-hpcdir " ++ hpcIndexDir ++ ddumpOpts] False -> return ["--ghc-options", ddumpOpts] -- Library and executable build components. primaryComponentOptions :: LocalPackage -> [String] primaryComponentOptions lp = concat [ ["lib:" ++ packageNameString (packageName (lpPackage lp)) -- TODO: get this information from target parsing instead, -- which will allow users to turn off library building if -- desired | packageHasLibrary (lpPackage lp)] , map (T.unpack . T.append "exe:") $ Set.toList $ exesToBuild lp ] exesToBuild :: LocalPackage -> Set Text exesToBuild lp = packageExes (lpPackage lp) -- NOTE: Ideally we'd do something like the following code, allowing -- the user to control which executables get built. However, due to -- https://github.com/haskell/cabal/issues/2780 we must build all -- exes... -- -- if lpWanted lp -- then exeComponents (lpComponents lp) -- -- Build all executables in the event that no -- -- specific list is provided (as happens with -- -- extra-deps). -- else packageExes (lpPackage lp) -- Test-suite and benchmark build components. finalComponentOptions :: LocalPackage -> [String] finalComponentOptions lp = map (T.unpack . decodeUtf8 . renderComponent) $ Set.toList $ Set.filter (\c -> isCTest c || isCBench c) (lpComponents lp) taskComponents :: Task -> Set NamedComponent taskComponents task = case taskType task of TTLocal lp -> lpComponents lp TTUpstream{} -> Set.empty -- | Take the given list of package dependencies and the contents of the global -- package database, and construct a set of installed package IDs that: -- -- * Excludes the Cabal library (it's added later) -- -- * Includes all packages depended on by this package -- -- * Includes all global packages, unless: (1) it's hidden, (2) it's shadowed -- by a depended-on package, or (3) one of its dependencies is not met. -- -- See: -- -- * https://github.com/commercialhaskell/stack/issues/941 -- -- * https://github.com/commercialhaskell/stack/issues/944 -- -- * https://github.com/commercialhaskell/stack/issues/949 addGlobalPackages :: Map PackageIdentifier GhcPkgId -- ^ dependencies of the package -> [DumpPackage () ()] -- ^ global packages -> Set GhcPkgId addGlobalPackages deps globals0 = res where -- Initial set of packages: the installed IDs of all dependencies res0 = Map.elems $ Map.filterWithKey (\ident _ -> not $ isCabal ident) deps -- First check on globals: it's not shadowed by a dep, it's not Cabal, and -- it's exposed goodGlobal1 dp = not (isDep dp) && not (isCabal $ dpPackageIdent dp) && dpIsExposed dp globals1 = filter goodGlobal1 globals0 -- Create a Map of unique package names in the global database globals2 = Map.fromListWith chooseBest $ map (packageIdentifierName . dpPackageIdent &&& id) globals1 -- Final result: add in globals that have their dependencies met res = loop id (Map.elems globals2) $ Set.fromList res0 ---------------------------------- -- Some auxiliary helper functions ---------------------------------- -- Is the given package identifier for any version of Cabal isCabal (PackageIdentifier name _) = name == $(mkPackageName "Cabal") -- Is the given package name provided by the package dependencies? isDep dp = packageIdentifierName (dpPackageIdent dp) `Set.member` depNames depNames = Set.map packageIdentifierName $ Map.keysSet deps -- Choose the best of two competing global packages (the newest version) chooseBest dp1 dp2 | getVer dp1 < getVer dp2 = dp2 | otherwise = dp1 where getVer = packageIdentifierVersion . dpPackageIdent -- Are all dependencies of the given package met by the given Set of -- installed packages depsMet dp gids = all (`Set.member` gids) (dpDepends dp) -- Find all globals that have all of their dependencies met loop front (dp:dps) gids -- This package has its deps met. Add it to the list of dependencies -- and then traverse the list from the beginning (this package may have -- been a dependency of an earlier one). | depsMet dp gids = loop id (front dps) (Set.insert (dpGhcPkgId dp) gids) -- Deps are not met, keep going | otherwise = loop (front . (dp:)) dps gids -- None of the packages we checked can be added, therefore drop them all -- and return our results loop _ [] gids = gids stack-1.1.2/src/Stack/Build/Haddock.hs0000644000000000000000000003170412717707440015610 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -- | Generate haddocks module Stack.Build.Haddock ( generateLocalHaddockIndex , generateDepsHaddockIndex , generateSnapHaddockIndex , openHaddocksInBrowser , shouldHaddockPackage , shouldHaddockDeps ) where import Control.Exception (tryJust, onException) import Control.Monad import Control.Monad.Catch (MonadCatch) import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Trans.Resource import qualified Data.Foldable as F import Data.Function import qualified Data.HashSet as HS import Data.List import Data.List.Extra (nubOrd) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe import Data.Maybe.Extra (mapMaybeM) import Data.Monoid ((<>)) import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Time (UTCTime) import Path import Path.Extra import Path.IO import Prelude import Stack.PackageDump import Stack.Types import qualified System.FilePath as FP import System.IO.Error (isDoesNotExistError) import System.Process.Read import Web.Browser (openBrowser) openHaddocksInBrowser :: (MonadIO m, MonadThrow m, MonadLogger m) => BaseConfigOpts -> Map PackageName (PackageIdentifier, InstallLocation) -- ^ Available packages and their locations for the current project -> Set PackageName -- ^ Build targets as determined by 'Stack.Build.Source.loadSourceMap' -> m () openHaddocksInBrowser bco pkgLocations buildTargets = do let cliTargets = (boptsCLITargets . bcoBuildOptsCLI) bco getDocIndex = do let localDocs = haddockIndexFile (localDepsDocDir bco) localExists <- doesFileExist localDocs if localExists then return localDocs else do let snapDocs = haddockIndexFile (snapDocDir bco) snapExists <- doesFileExist snapDocs if snapExists then return snapDocs else fail "No local or snapshot doc index found to open." docFile <- case (cliTargets, map (`Map.lookup` pkgLocations) (Set.toList buildTargets)) of ([_], [Just (pkgId, iloc)]) -> do pkgRelDir <- (parseRelDir . packageIdentifierString) pkgId let docLocation = case iloc of Snap -> snapDocDir bco Local -> localDocDir bco let docFile = haddockIndexFile (docLocation pkgRelDir) exists <- doesFileExist docFile if exists then return docFile else do $logWarn $ "Expected to find documentation at " <> T.pack (toFilePath docFile) <> ", but that file is missing. Opening doc index instead." getDocIndex _ -> getDocIndex $logInfo ("Opening " <> T.pack (toFilePath docFile) <> " in the browser.") _ <- liftIO $ openBrowser (toFilePath docFile) return () -- | Determine whether we should haddock for a package. shouldHaddockPackage :: BuildOpts -> Set PackageName -- ^ Packages that we want to generate haddocks for -- in any case (whether or not we are going to generate -- haddocks for dependencies) -> PackageName -> Bool shouldHaddockPackage bopts wanted name = if Set.member name wanted then boptsHaddock bopts else shouldHaddockDeps bopts -- | Determine whether to build haddocks for dependencies. shouldHaddockDeps :: BuildOpts -> Bool shouldHaddockDeps bopts = fromMaybe (boptsHaddock bopts) (boptsHaddockDeps bopts) -- | Generate Haddock index and contents for local packages. generateLocalHaddockIndex :: (MonadIO m, MonadCatch m, MonadLogger m, MonadBaseControl IO m) => EnvOverride -> WhichCompiler -> BaseConfigOpts -> Map GhcPkgId (DumpPackage () ()) -- ^ Local package dump -> [LocalPackage] -> m () generateLocalHaddockIndex envOverride wc bco localDumpPkgs locals = do let dumpPackages = mapMaybe (\LocalPackage{lpPackage = Package{..}} -> F.find (\dp -> dpPackageIdent dp == PackageIdentifier packageName packageVersion) localDumpPkgs) locals generateHaddockIndex "local packages" envOverride wc (boptsHaddockOpts (bcoBuildOpts bco)) dumpPackages "." (localDocDir bco) -- | Generate Haddock index and contents for local packages and their dependencies. generateDepsHaddockIndex :: (MonadIO m, MonadCatch m, MonadLogger m, MonadBaseControl IO m) => EnvOverride -> WhichCompiler -> BaseConfigOpts -> Map GhcPkgId (DumpPackage () ()) -- ^ Global dump information -> Map GhcPkgId (DumpPackage () ()) -- ^ Snapshot dump information -> Map GhcPkgId (DumpPackage () ()) -- ^ Local dump information -> [LocalPackage] -> m () generateDepsHaddockIndex envOverride wc bco globalDumpPkgs snapshotDumpPkgs localDumpPkgs locals = do let deps = (mapMaybe (`lookupDumpPackage` allDumpPkgs) . nubOrd . findTransitiveDepends . mapMaybe getGhcPkgId) locals depDocDir = localDepsDocDir bco generateHaddockIndex "local packages and dependencies" envOverride wc (boptsHaddockOpts (bcoBuildOpts bco)) deps ".." depDocDir where getGhcPkgId :: LocalPackage -> Maybe GhcPkgId getGhcPkgId LocalPackage{lpPackage = Package{..}} = let pkgId = PackageIdentifier packageName packageVersion mdpPkg = F.find (\dp -> dpPackageIdent dp == pkgId) localDumpPkgs in fmap dpGhcPkgId mdpPkg findTransitiveDepends :: [GhcPkgId] -> [GhcPkgId] findTransitiveDepends = (`go` HS.empty) . HS.fromList where go todo checked = case HS.toList todo of [] -> HS.toList checked (ghcPkgId:_) -> let deps = case lookupDumpPackage ghcPkgId allDumpPkgs of Nothing -> HS.empty Just pkgDP -> HS.fromList (dpDepends pkgDP) deps' = deps `HS.difference` checked todo' = HS.delete ghcPkgId (deps' `HS.union` todo) checked' = HS.insert ghcPkgId checked in go todo' checked' allDumpPkgs = [localDumpPkgs, snapshotDumpPkgs, globalDumpPkgs] -- | Generate Haddock index and contents for all snapshot packages. generateSnapHaddockIndex :: (MonadIO m, MonadCatch m, MonadLogger m, MonadBaseControl IO m) => EnvOverride -> WhichCompiler -> BaseConfigOpts -> Map GhcPkgId (DumpPackage () ()) -- ^ Global package dump -> Map GhcPkgId (DumpPackage () ()) -- ^ Snapshot package dump -> m () generateSnapHaddockIndex envOverride wc bco globalDumpPkgs snapshotDumpPkgs = generateHaddockIndex "snapshot packages" envOverride wc (boptsHaddockOpts (bcoBuildOpts bco)) (Map.elems snapshotDumpPkgs ++ Map.elems globalDumpPkgs) "." (snapDocDir bco) -- | Generate Haddock index and contents for specified packages. generateHaddockIndex :: (MonadIO m, MonadCatch m, MonadLogger m, MonadBaseControl IO m) => Text -> EnvOverride -> WhichCompiler -> HaddockOpts -> [DumpPackage () ()] -> FilePath -> Path Abs Dir -> m () generateHaddockIndex descr envOverride wc hdopts dumpPackages docRelFP destDir = do ensureDir destDir interfaceOpts <- (liftIO . fmap nubOrd . mapMaybeM toInterfaceOpt) dumpPackages unless (null interfaceOpts) $ do let destIndexFile = haddockIndexFile destDir eindexModTime <- liftIO (tryGetModificationTime destIndexFile) let needUpdate = case eindexModTime of Left _ -> True Right indexModTime -> or [mt > indexModTime | (_,mt,_,_) <- interfaceOpts] when needUpdate $ do $logInfo (T.concat ["Updating Haddock index for ", descr, " in\n", T.pack (toFilePath destIndexFile)]) liftIO (mapM_ copyPkgDocs interfaceOpts) readProcessNull (Just destDir) envOverride (haddockExeName wc) (toHaddockArgs hdopts ++ ["--gen-contents", "--gen-index"] ++ [x | (xs,_,_,_) <- interfaceOpts, x <- xs]) where toInterfaceOpt :: DumpPackage a b -> IO (Maybe ([String], UTCTime, Path Abs File, Path Abs File)) toInterfaceOpt DumpPackage {..} = case dpHaddockInterfaces of [] -> return Nothing srcInterfaceFP:_ -> do srcInterfaceAbsFile <- parseCollapsedAbsFile srcInterfaceFP let (PackageIdentifier name _) = dpPackageIdent destInterfaceRelFP = docRelFP FP. packageIdentifierString dpPackageIdent FP. (packageNameString name FP.<.> "haddock") destInterfaceAbsFile <- parseCollapsedAbsFile (toFilePath destDir FP. destInterfaceRelFP) esrcInterfaceModTime <- tryGetModificationTime srcInterfaceAbsFile return $ case esrcInterfaceModTime of Left _ -> Nothing Right srcInterfaceModTime -> Just ( [ "-i" , concat [ docRelFP FP. packageIdentifierString dpPackageIdent , "," , destInterfaceRelFP ]] , srcInterfaceModTime , srcInterfaceAbsFile , destInterfaceAbsFile ) tryGetModificationTime :: Path Abs File -> IO (Either () UTCTime) tryGetModificationTime = tryJust (guard . isDoesNotExistError) . getModificationTime copyPkgDocs :: (a, UTCTime, Path Abs File, Path Abs File) -> IO () copyPkgDocs (_,srcInterfaceModTime,srcInterfaceAbsFile,destInterfaceAbsFile) = do -- Copy dependencies' haddocks to documentation directory. This way, relative @../$pkg-$ver@ -- links work and it's easy to upload docs to a web server or otherwise view them in a -- non-local-filesystem context. We copy instead of symlink for two reasons: (1) symlinks -- aren't reliably supported on Windows, and (2) the filesystem containing dependencies' -- docs may not be available where viewing the docs (e.g. if building in a Docker -- container). edestInterfaceModTime <- tryGetModificationTime destInterfaceAbsFile case edestInterfaceModTime of Left _ -> doCopy Right destInterfaceModTime | destInterfaceModTime < srcInterfaceModTime -> doCopy | otherwise -> return () where doCopy = do ignoringAbsence (removeDirRecur destHtmlAbsDir) ensureDir destHtmlAbsDir onException (copyDirRecur' (parent srcInterfaceAbsFile) destHtmlAbsDir) (ignoringAbsence (removeDirRecur destHtmlAbsDir)) destHtmlAbsDir = parent destInterfaceAbsFile -- | Find first DumpPackage matching the GhcPkgId lookupDumpPackage :: GhcPkgId -> [Map GhcPkgId (DumpPackage () ())] -> Maybe (DumpPackage () ()) lookupDumpPackage ghcPkgId dumpPkgs = listToMaybe $ mapMaybe (Map.lookup ghcPkgId) dumpPkgs -- | Path of haddock index file. haddockIndexFile :: Path Abs Dir -> Path Abs File haddockIndexFile destDir = destDir $(mkRelFile "index.html") -- | Path of local packages documentation directory. localDocDir :: BaseConfigOpts -> Path Abs Dir localDocDir bco = bcoLocalInstallRoot bco docDirSuffix -- | Path of documentation directory for the dependencies of local packages localDepsDocDir :: BaseConfigOpts -> Path Abs Dir localDepsDocDir bco = localDocDir bco $(mkRelDir "all") -- | Path of snapshot packages documentation directory. snapDocDir :: BaseConfigOpts -> Path Abs Dir snapDocDir bco = bcoSnapInstallRoot bco docDirSuffix stack-1.1.2/src/Stack/Build/Installed.hs0000644000000000000000000002717012670053551016167 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- Determine which packages are already installed module Stack.Build.Installed ( InstalledMap , Installed (..) , GetInstalledOpts (..) , getInstalled ) where import Control.Applicative import Control.Monad import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Trans.Resource import Data.Conduit import qualified Data.Conduit.List as CL import Data.Function import qualified Data.Foldable as F import qualified Data.HashSet as HashSet import Data.List import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import qualified Data.Map.Strict as Map import Data.Maybe import Data.Maybe.Extra (mapMaybeM) import Data.Monoid import qualified Data.Text as T import Network.HTTP.Client.Conduit (HasHttpManager) import Path import Prelude hiding (FilePath, writeFile) import Stack.Build.Cache import Stack.Types.Build import Stack.Types.Version import Stack.Constants import Stack.GhcPkg import Stack.PackageDump import Stack.Types import Stack.Types.Internal type M env m = (MonadIO m,MonadReader env m,HasHttpManager env,HasEnvConfig env,MonadLogger m,MonadBaseControl IO m,MonadMask m,HasLogLevel env) -- | Options for 'getInstalled'. data GetInstalledOpts = GetInstalledOpts { getInstalledProfiling :: !Bool -- ^ Require profiling libraries? , getInstalledHaddock :: !Bool -- ^ Require haddocks? } -- | Returns the new InstalledMap and all of the locally registered packages. getInstalled :: (M env m, PackageInstallInfo pii) => EnvOverride -> GetInstalledOpts -> Map PackageName pii -- ^ does not contain any installed information -> m ( InstalledMap , [DumpPackage () ()] -- globally installed , [DumpPackage () ()] -- snapshot installed , [DumpPackage () ()] -- locally installed ) getInstalled menv opts sourceMap = do snapDBPath <- packageDatabaseDeps localDBPath <- packageDatabaseLocal extraDBPaths <- packageDatabaseExtra bconfig <- asks getBuildConfig mcache <- if getInstalledProfiling opts || getInstalledHaddock opts then liftM Just $ loadInstalledCache $ configInstalledCache bconfig else return Nothing let loadDatabase' = loadDatabase menv opts mcache sourceMap (installedLibs0, globalDumpPkgs) <- loadDatabase' Nothing [] (installedLibs1, _extraInstalled) <- (foldM (\lhs' pkgdb -> loadDatabase' (Just (ExtraGlobal, pkgdb)) (fst lhs') ) (installedLibs0, globalDumpPkgs) extraDBPaths) (installedLibs2, snapshotDumpPkgs) <- loadDatabase' (Just (InstalledTo Snap, snapDBPath)) installedLibs1 (installedLibs3, localDumpPkgs) <- loadDatabase' (Just (InstalledTo Local, localDBPath)) installedLibs2 let installedLibs = M.fromList $ map lhPair installedLibs3 F.forM_ mcache (saveInstalledCache (configInstalledCache bconfig)) -- Add in the executables that are installed, making sure to only trust a -- listed installation under the right circumstances (see below) let exesToSM loc = Map.unions . map (exeToSM loc) exeToSM loc (PackageIdentifier name version) = case Map.lookup name sourceMap of -- Doesn't conflict with anything, so that's OK Nothing -> m Just pii -- Not the version we want, ignore it | version /= piiVersion pii || loc /= piiLocation pii -> Map.empty | otherwise -> m where m = Map.singleton name (loc, Executable $ PackageIdentifier name version) exesSnap <- getInstalledExes Snap exesLocal <- getInstalledExes Local let installedMap = Map.unions [ exesToSM Local exesLocal , exesToSM Snap exesSnap , installedLibs ] return ( installedMap , globalDumpPkgs , snapshotDumpPkgs , localDumpPkgs ) -- | Outputs both the modified InstalledMap and the Set of all installed packages in this database -- -- The goal is to ascertain that the dependencies for a package are present, -- that it has profiling if necessary, and that it matches the version and -- location needed by the SourceMap loadDatabase :: (M env m, PackageInstallInfo pii) => EnvOverride -> GetInstalledOpts -> Maybe InstalledCache -- ^ if Just, profiling or haddock is required -> Map PackageName pii -- ^ to determine which installed things we should include -> Maybe (InstalledPackageLocation, Path Abs Dir) -- ^ package database, Nothing for global -> [LoadHelper] -- ^ from parent databases -> m ([LoadHelper], [DumpPackage () ()]) loadDatabase menv opts mcache sourceMap mdb lhs0 = do wc <- getWhichCompiler (lhs1', dps) <- ghcPkgDump menv wc (fmap snd (maybeToList mdb)) $ conduitDumpPackage =$ sink let ghcjsHack = wc == Ghcjs && isNothing mdb lhs1 <- mapMaybeM (processLoadResult mdb ghcjsHack) lhs1' let lhs = pruneDeps id lhId lhDeps const (lhs0 ++ lhs1) return (map (\lh -> lh { lhDeps = [] }) $ Map.elems lhs, dps) where conduitProfilingCache = case mcache of Just cache | getInstalledProfiling opts -> addProfiling cache -- Just an optimization to avoid calculating the profiling -- values when they aren't necessary _ -> CL.map (\dp -> dp { dpProfiling = False }) conduitHaddockCache = case mcache of Just cache | getInstalledHaddock opts -> addHaddock cache -- Just an optimization to avoid calculating the haddock -- values when they aren't necessary _ -> CL.map (\dp -> dp { dpHaddock = False }) mloc = fmap fst mdb sinkDP = conduitProfilingCache =$ conduitHaddockCache =$ CL.map (\dp -> (isAllowed opts mcache sourceMap mloc dp, toLoadHelper mloc dp)) =$ CL.consume sink = getZipSink $ (,) <$> ZipSink sinkDP <*> ZipSink CL.consume processLoadResult :: MonadLogger m => Maybe (InstalledPackageLocation, Path Abs Dir) -> Bool -> (Allowed, LoadHelper) -> m (Maybe LoadHelper) processLoadResult _ _ (Allowed, lh) = return (Just lh) processLoadResult _ True (WrongVersion actual wanted, lh) -- Allow some packages in the ghcjs global DB to have the wrong -- versions. Treat them as wired-ins by setting deps to []. | fst (lhPair lh) `HashSet.member` ghcjsBootPackages = do $logWarn $ T.concat [ "Ignoring that the GHCJS boot package \"" , packageNameText (fst (lhPair lh)) , "\" has a different version, " , versionText actual , ", than the resolver's wanted version, " , versionText wanted ] return (Just lh) processLoadResult mdb _ (reason, lh) = do $logDebug $ T.concat $ [ "Ignoring package " , packageNameText (fst (lhPair lh)) ] ++ maybe [] (\db -> [", from ", T.pack (show db), ","]) mdb ++ [ " due to" , case reason of Allowed -> " the impossible?!?!" NeedsProfiling -> " it needing profiling." NeedsHaddock -> " it needing haddocks." UnknownPkg -> " it being unknown to the resolver / extra-deps." WrongLocation mloc loc -> " wrong location: " <> T.pack (show (mloc, loc)) WrongVersion actual wanted -> T.concat [ " wanting version " , versionText wanted , " instead of " , versionText actual ] ] return Nothing data Allowed = Allowed | NeedsProfiling | NeedsHaddock | UnknownPkg | WrongLocation (Maybe InstalledPackageLocation) InstallLocation | WrongVersion Version Version deriving (Eq, Show) -- | Check if a can be included in the set of installed packages or not, based -- on the package selections made by the user. This does not perform any -- dirtiness or flag change checks. isAllowed :: PackageInstallInfo pii => GetInstalledOpts -> Maybe InstalledCache -> Map PackageName pii -> Maybe InstalledPackageLocation -> DumpPackage Bool Bool -> Allowed isAllowed opts mcache sourceMap mloc dp -- Check that it can do profiling if necessary | getInstalledProfiling opts && isJust mcache && not (dpProfiling dp) = NeedsProfiling -- Check that it has haddocks if necessary | getInstalledHaddock opts && isJust mcache && not (dpHaddock dp) = NeedsHaddock | otherwise = case Map.lookup name sourceMap of Nothing -> case mloc of -- The sourceMap has nothing to say about this global -- package, so we can use it Nothing -> Allowed Just ExtraGlobal -> Allowed -- For non-global packages, don't include unknown packages. -- See: -- https://github.com/commercialhaskell/stack/issues/292 Just _ -> UnknownPkg Just pii | not (checkLocation (piiLocation pii)) -> WrongLocation mloc (piiLocation pii) | version /= piiVersion pii -> WrongVersion version (piiVersion pii) | otherwise -> Allowed where PackageIdentifier name version = dpPackageIdent dp -- Ensure that the installed location matches where the sourceMap says it -- should be installed checkLocation Snap = mloc /= Just (InstalledTo Local) -- we can allow either global or snap checkLocation Local = mloc == Just (InstalledTo Local) || mloc == Just ExtraGlobal -- 'locally' installed snapshot packages can come from extra dbs data LoadHelper = LoadHelper { lhId :: !GhcPkgId , lhDeps :: ![GhcPkgId] , lhPair :: !(PackageName, (InstallLocation, Installed)) } deriving Show toLoadHelper :: Maybe InstalledPackageLocation -> DumpPackage Bool Bool -> LoadHelper toLoadHelper mloc dp = LoadHelper { lhId = gid , lhDeps = -- We always want to consider the wired in packages as having all -- of their dependencies installed, since we have no ability to -- reinstall them. This is especially important for using different -- minor versions of GHC, where the dependencies of wired-in -- packages may change slightly and therefore not match the -- snapshot. if name `HashSet.member` wiredInPackages then [] else dpDepends dp , lhPair = (name, (toPackageLocation mloc, Library ident gid)) } where gid = dpGhcPkgId dp ident@(PackageIdentifier name _) = dpPackageIdent dp toPackageLocation :: Maybe InstalledPackageLocation -> InstallLocation toPackageLocation Nothing = Snap toPackageLocation (Just ExtraGlobal) = Snap toPackageLocation (Just (InstalledTo loc)) = loc stack-1.1.2/src/Stack/Build/Source.hs0000644000000000000000000006337112717707440015520 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} -- Load information on package sources module Stack.Build.Source ( loadSourceMap , SourceMap , PackageSource (..) , getLocalFlags , getGhcOptions , getLocalPackageViews , parseTargetsFromBuildOpts , addUnlistedToBuildCache , getDefaultPackageConfig , getPackageConfig ) where import Control.Applicative import Control.Arrow ((&&&)) import Control.Exception (assert, catch) import Control.Monad hiding (sequence) import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Trans.Resource import "cryptohash" Crypto.Hash (Digest, SHA256) import Crypto.Hash.Conduit (sinkHash) import qualified Data.ByteString as S import Data.Byteable (toBytes) import Data.Conduit (($$), ZipSink (..)) import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import Data.Either import Data.Function import qualified Data.HashSet as HashSet import Data.List import qualified Data.Map as Map import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe import Data.Monoid import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Traversable (sequence) import Distribution.Package (pkgName, pkgVersion) import Distribution.PackageDescription (GenericPackageDescription, package, packageDescription) import qualified Distribution.PackageDescription as C import Network.HTTP.Client.Conduit (HasHttpManager) import Path import Path.IO import Prelude hiding (sequence) import Stack.Build.Cache import Stack.Build.Target import Stack.BuildPlan (shadowMiniBuildPlan) import Stack.Constants (wiredInPackages) import Stack.Package import Stack.PackageIndex (getPackageVersions) import Stack.Types import qualified System.Directory as D import System.FilePath (takeFileName) import System.IO (withBinaryFile, IOMode (ReadMode)) import System.IO.Error (isDoesNotExistError) loadSourceMap :: (MonadIO m, MonadMask m, MonadReader env m, MonadBaseControl IO m, HasHttpManager env, MonadLogger m, HasEnvConfig env) => NeedTargets -> BuildOptsCLI -> m ( Map PackageName SimpleTarget , MiniBuildPlan , [LocalPackage] , Set PackageName -- non-local targets , SourceMap ) loadSourceMap needTargets boptsCli = do bconfig <- asks getBuildConfig rawLocals <- getLocalPackageViews (mbp0, cliExtraDeps, targets) <- parseTargetsFromBuildOpts needTargets boptsCli -- Extend extra-deps to encompass targets requested on the command line -- that are not in the snapshot. extraDeps0 <- extendExtraDeps (bcExtraDeps bconfig) cliExtraDeps (Map.keysSet $ Map.filter (== STUnknown) targets) locals <- mapM (loadLocalPackage boptsCli targets) $ Map.toList rawLocals checkFlagsUsed boptsCli locals extraDeps0 (mbpPackages mbp0) checkComponentsBuildable locals let -- loadLocals returns PackageName (foo) and PackageIdentifier (bar-1.2.3) targets separately; -- here we combine them into nonLocalTargets. This is one of the -- return values of this function. nonLocalTargets :: Set PackageName nonLocalTargets = Map.keysSet $ Map.filter (not . isLocal) targets where isLocal (STLocalComps _) = True isLocal STLocalAll = True isLocal STUnknown = False isLocal STNonLocal = False shadowed = Map.keysSet rawLocals <> Map.keysSet extraDeps0 (mbp, extraDeps1) = shadowMiniBuildPlan mbp0 shadowed -- Add the extra deps from the stack.yaml file to the deps grabbed from -- the snapshot extraDeps2 = Map.union (Map.map (\v -> (v, Map.empty, [])) extraDeps0) (Map.map (\mpi -> (mpiVersion mpi, mpiFlags mpi, mpiGhcOptions mpi)) extraDeps1) -- Add flag and ghc-option settings from the config file / cli extraDeps3 = Map.mapWithKey (\n (v, flags0, ghcOptions0) -> let flags = case ( Map.lookup (Just n) $ boptsCLIFlags boptsCli , Map.lookup Nothing $ boptsCLIFlags boptsCli , Map.lookup n $ unPackageFlags $ bcFlags bconfig ) of -- Didn't have any flag overrides, fall back to the flags -- defined in the snapshot. (Nothing, Nothing, Nothing) -> flags0 -- Either command line flag for this package, general -- command line flag, or flag in stack.yaml is defined. -- Take all of those and ignore the snapshot flags. (x, y, z) -> Map.unions [ fromMaybe Map.empty x , fromMaybe Map.empty y , fromMaybe Map.empty z ] ghcOptions = ghcOptions0 ++ getGhcOptions bconfig boptsCli n False False -- currently have no ability for extra-deps to specify their -- cabal file hashes in PSUpstream v Local flags ghcOptions Nothing) extraDeps2 let sourceMap = Map.unions [ Map.fromList $ flip map locals $ \lp -> let p = lpPackage lp in (packageName p, PSLocal lp) , extraDeps3 , flip fmap (mbpPackages mbp) $ \mpi -> PSUpstream (mpiVersion mpi) Snap (mpiFlags mpi) (mpiGhcOptions mpi) (mpiGitSHA1 mpi) ] `Map.difference` Map.fromList (map (, ()) (HashSet.toList wiredInPackages)) return (targets, mbp, locals, nonLocalTargets, sourceMap) -- | All flags for a local package getLocalFlags :: BuildConfig -> BuildOptsCLI -> PackageName -> Map FlagName Bool getLocalFlags bconfig boptsCli name = Map.unions [ Map.findWithDefault Map.empty (Just name) cliFlags , Map.findWithDefault Map.empty Nothing cliFlags , Map.findWithDefault Map.empty name (unPackageFlags (bcFlags bconfig)) ] where cliFlags = boptsCLIFlags boptsCli getGhcOptions :: BuildConfig -> BuildOptsCLI -> PackageName -> Bool -> Bool -> [Text] getGhcOptions bconfig boptsCli name isTarget isLocal = concat [ ghcOptionsFor name (configGhcOptions config) , concat [["-fhpc"] | isLocal && toCoverage (boptsTestOpts bopts)] , if (boptsLibProfile bopts || boptsExeProfile bopts) then ["-auto-all","-caf-all"] else [] , if includeExtraOptions then boptsCLIGhcOptions boptsCli else [] ] where bopts = configBuild config config = bcConfig bconfig includeExtraOptions = case configApplyGhcOptions config of AGOTargets -> isTarget AGOLocals -> isLocal AGOEverything -> True -- | Use the build options and environment to parse targets. parseTargetsFromBuildOpts :: (MonadIO m, MonadMask m, MonadReader env m, MonadLogger m, HasEnvConfig env) => NeedTargets -> BuildOptsCLI -> m (MiniBuildPlan, M.Map PackageName Version, M.Map PackageName SimpleTarget) parseTargetsFromBuildOpts needTargets boptscli = do bconfig <- asks getBuildConfig mbp0 <- case bcResolver bconfig of ResolverCompiler _ -> do -- We ignore the resolver version, as it might be -- GhcMajorVersion, and we want the exact version -- we're using. version <- asks (envConfigCompilerVersion . getEnvConfig) return MiniBuildPlan { mbpCompilerVersion = version , mbpPackages = Map.empty } _ -> return (bcWantedMiniBuildPlan bconfig) rawLocals <- getLocalPackageViews workingDir <- getCurrentDir let snapshot = mpiVersion <$> mbpPackages mbp0 flagExtraDeps <- convertSnapshotToExtra snapshot (bcExtraDeps bconfig) rawLocals (catMaybes $ Map.keys $ boptsCLIFlags boptscli) (cliExtraDeps, targets) <- parseTargets needTargets (bcImplicitGlobal bconfig) snapshot (flagExtraDeps <> bcExtraDeps bconfig) (fst <$> rawLocals) workingDir (boptsCLITargets boptscli) return (mbp0, cliExtraDeps <> flagExtraDeps, targets) -- | For every package in the snapshot which is referenced by a flag, give the -- user a warning and then add it to extra-deps. convertSnapshotToExtra :: MonadLogger m => Map PackageName Version -- ^ snapshot -> Map PackageName Version -- ^ extra-deps -> Map PackageName a -- ^ locals -> [PackageName] -- ^ packages referenced by a flag -> m (Map PackageName Version) convertSnapshotToExtra snapshot extra0 locals = go Map.empty where go !extra [] = return extra go extra (flag:flags) | Just _ <- Map.lookup flag extra0 = go extra flags | flag `Map.member` locals = go extra flags | otherwise = case Map.lookup flag snapshot of Nothing -> go extra flags Just version -> do $logWarn $ T.concat [ "- Implicitly adding " , T.pack $ packageNameString flag , " to extra-deps based on command line flag" ] go (Map.insert flag version extra) flags -- | Parse out the local package views for the current project getLocalPackageViews :: (MonadThrow m, MonadIO m, MonadReader env m, HasEnvConfig env, MonadLogger m) => m (Map PackageName (LocalPackageView, GenericPackageDescription)) getLocalPackageViews = do econfig <- asks getEnvConfig locals <- forM (Map.toList $ envConfigPackages econfig) $ \(dir, treatLikeExtraDep) -> do cabalfp <- findOrGenerateCabalFile dir (warnings,gpkg) <- readPackageUnresolved cabalfp mapM_ (printCabalFileWarning cabalfp) warnings let cabalID = package $ packageDescription gpkg name = fromCabalPackageName $ pkgName cabalID checkCabalFileName name cabalfp let lpv = LocalPackageView { lpvVersion = fromCabalVersion $ pkgVersion cabalID , lpvRoot = dir , lpvCabalFP = cabalfp , lpvExtraDep = treatLikeExtraDep , lpvComponents = getNamedComponents gpkg } return (name, (lpv, gpkg)) checkDuplicateNames locals return $ Map.fromList locals where getNamedComponents gpkg = Set.fromList $ concat [ maybe [] (const [CLib]) (C.condLibrary gpkg) , go CExe C.condExecutables , go CTest C.condTestSuites , go CBench C.condBenchmarks ] where go wrapper f = map (wrapper . T.pack . fst) $ f gpkg -- | Check if there are any duplicate package names and, if so, throw an -- exception. checkDuplicateNames :: MonadThrow m => [(PackageName, (LocalPackageView, gpd))] -> m () checkDuplicateNames locals = case filter hasMultiples $ Map.toList $ Map.fromListWith (++) $ map toPair locals of [] -> return () x -> throwM $ DuplicateLocalPackageNames x where toPair (pn, (lpv, _)) = (pn, [lpvRoot lpv]) hasMultiples (_, _:_:_) = True hasMultiples _ = False splitComponents :: [NamedComponent] -> (Set Text, Set Text, Set Text) splitComponents = go id id id where go a b c [] = (Set.fromList $ a [], Set.fromList $ b [], Set.fromList $ c []) go a b c (CLib:xs) = go a b c xs go a b c (CExe x:xs) = go (a . (x:)) b c xs go a b c (CTest x:xs) = go a (b . (x:)) c xs go a b c (CBench x:xs) = go a b (c . (x:)) xs -- | Upgrade the initial local package info to a full-blown @LocalPackage@ -- based on the selected components loadLocalPackage :: forall m env. (MonadReader env m, HasEnvConfig env, MonadMask m, MonadLogger m, MonadIO m) => BuildOptsCLI -> Map PackageName SimpleTarget -> (PackageName, (LocalPackageView, GenericPackageDescription)) -> m LocalPackage loadLocalPackage boptsCli targets (name, (lpv, gpkg)) = do let mtarget = Map.lookup name targets config <- getPackageConfig boptsCli name (isJust mtarget) True bopts <- asks (configBuild . getConfig) let pkg = resolvePackage config gpkg (exes, tests, benches) = case mtarget of Just (STLocalComps comps) -> splitComponents $ Set.toList comps Just STLocalAll -> ( packageExes pkg , if boptsTests bopts then Map.keysSet (packageTests pkg) else Set.empty , if boptsBenchmarks bopts then packageBenchmarks pkg else Set.empty ) Just STNonLocal -> assert False mempty Just STUnknown -> assert False mempty Nothing -> mempty toComponents e t b = Set.unions [ Set.map CExe e , Set.map CTest t , Set.map CBench b ] btconfig = config { packageConfigEnableTests = not $ Set.null tests , packageConfigEnableBenchmarks = not $ Set.null benches } testconfig = config { packageConfigEnableTests = True , packageConfigEnableBenchmarks = False } benchconfig = config { packageConfigEnableTests = False , packageConfigEnableBenchmarks = True } btpkg | Set.null tests && Set.null benches = Nothing | otherwise = Just (resolvePackage btconfig gpkg) testpkg = resolvePackage testconfig gpkg benchpkg = resolvePackage benchconfig gpkg mbuildCache <- tryGetBuildCache $ lpvRoot lpv (files,_) <- getPackageFilesSimple pkg (lpvCabalFP lpv) (dirtyFiles, newBuildCache) <- checkBuildCache (fromMaybe Map.empty mbuildCache) (Set.toList files) return LocalPackage { lpPackage = pkg , lpTestDeps = packageDeps testpkg , lpBenchDeps = packageDeps benchpkg , lpTestBench = btpkg , lpFiles = files , lpForceDirty = boptsForceDirty bopts , lpDirtyFiles = if not (Set.null dirtyFiles) then let tryStripPrefix y = fromMaybe y (stripPrefix (toFilePath $ lpvRoot lpv) y) in Just $ Set.map tryStripPrefix dirtyFiles else Nothing , lpNewBuildCache = newBuildCache , lpCabalFile = lpvCabalFP lpv , lpDir = lpvRoot lpv , lpWanted = isJust mtarget , lpComponents = toComponents exes tests benches -- TODO: refactor this so that it's easier to be sure that these -- components are indeed unbuildable. -- -- The reasoning here is that if the STLocalComps specification -- made it through component parsing, but the components aren't -- present, then they must not be buildable. , lpUnbuildable = toComponents (exes `Set.difference` packageExes pkg) (tests `Set.difference` Map.keysSet (packageTests pkg)) (benches `Set.difference` packageBenchmarks pkg) } -- | Ensure that the flags specified in the stack.yaml file and on the command -- line are used. checkFlagsUsed :: (MonadThrow m, MonadReader env m, HasBuildConfig env) => BuildOptsCLI -> [LocalPackage] -> Map PackageName extraDeps -- ^ extra deps -> Map PackageName snapshot -- ^ snapshot, for error messages -> m () checkFlagsUsed boptsCli lps extraDeps snapshot = do bconfig <- asks getBuildConfig -- Check if flags specified in stack.yaml and the command line are -- used, see https://github.com/commercialhaskell/stack/issues/617 let flags = map (, FSCommandLine) [(k, v) | (Just k, v) <- Map.toList $ boptsCLIFlags boptsCli] ++ map (, FSStackYaml) (Map.toList $ unPackageFlags $ bcFlags bconfig) localNameMap = Map.fromList $ map (packageName . lpPackage &&& lpPackage) lps checkFlagUsed ((name, userFlags), source) = case Map.lookup name localNameMap of -- Package is not available locally Nothing -> case Map.lookup name extraDeps of -- Also not in extra-deps, it's an error Nothing -> case Map.lookup name snapshot of Nothing -> Just $ UFNoPackage source name Just _ -> Just $ UFSnapshot name -- We don't check for flag presence for extra deps Just _ -> Nothing -- Package exists locally, let's check if the flags are defined Just pkg -> let unused = Set.difference (Map.keysSet userFlags) (packageDefinedFlags pkg) in if Set.null unused -- All flags are defined, nothing to do then Nothing -- Error about the undefined flags else Just $ UFFlagsNotDefined source pkg unused unusedFlags = mapMaybe checkFlagUsed flags unless (null unusedFlags) $ throwM $ InvalidFlagSpecification $ Set.fromList unusedFlags -- | Add in necessary packages to extra dependencies -- -- Originally part of https://github.com/commercialhaskell/stack/issues/272, -- this was then superseded by -- https://github.com/commercialhaskell/stack/issues/651 extendExtraDeps :: (HasBuildConfig env, MonadIO m, MonadLogger m, MonadReader env m, HasHttpManager env, MonadBaseControl IO m, MonadMask m) => Map PackageName Version -- ^ original extra deps -> Map PackageName Version -- ^ package identifiers from the command line -> Set PackageName -- ^ all packages added on the command line -> m (Map PackageName Version) -- ^ new extradeps extendExtraDeps extraDeps0 cliExtraDeps unknowns = do (errs, unknowns') <- fmap partitionEithers $ mapM addUnknown $ Set.toList unknowns case errs of [] -> return $ Map.unions $ extraDeps1 : unknowns' _ -> do bconfig <- asks getBuildConfig throwM $ UnknownTargets (Set.fromList errs) Map.empty -- TODO check the cliExtraDeps for presence in index (bcStackYaml bconfig) where extraDeps1 = Map.union extraDeps0 cliExtraDeps addUnknown pn = do case Map.lookup pn extraDeps1 of Just _ -> return (Right Map.empty) Nothing -> do mlatestVersion <- getLatestVersion pn case mlatestVersion of Just v -> return (Right $ Map.singleton pn v) Nothing -> return (Left pn) getLatestVersion pn = do vs <- getPackageVersions pn return (fmap fst (Set.maxView vs)) -- | Compare the current filesystem state to the cached information, and -- determine (1) if the files are dirty, and (2) the new cache values. checkBuildCache :: forall m. (MonadIO m) => Map FilePath FileCacheInfo -- ^ old cache -> [Path Abs File] -- ^ files in package -> m (Set FilePath, Map FilePath FileCacheInfo) checkBuildCache oldCache files = do fileTimes <- liftM Map.fromList $ forM files $ \fp -> do mmodTime <- liftIO (getModTimeMaybe (toFilePath fp)) return (toFilePath fp, mmodTime) liftM (mconcat . Map.elems) $ sequence $ Map.mergeWithKey (\fp mmodTime fci -> Just (go fp mmodTime (Just fci))) (Map.mapWithKey (\fp mmodTime -> go fp mmodTime Nothing)) (Map.mapWithKey (\fp fci -> go fp Nothing (Just fci))) fileTimes oldCache where go :: FilePath -> Maybe ModTime -> Maybe FileCacheInfo -> m (Set FilePath, Map FilePath FileCacheInfo) -- Filter out the cabal_macros file to avoid spurious recompilations go fp _ _ | takeFileName fp == "cabal_macros.h" = return (Set.empty, Map.empty) -- Common case where it's in the cache and on the filesystem. go fp (Just modTime') (Just fci) | fciModTime fci == modTime' = return (Set.empty, Map.empty) | otherwise = do newFci <- calcFci modTime' fp let isDirty = fciSize fci /= fciSize newFci || fciHash fci /= fciHash newFci newDirty = if isDirty then Set.singleton fp else Set.empty return (newDirty, Map.singleton fp newFci) -- Missing file. Add it to dirty files, but no FileCacheInfo. go fp Nothing _ = return (Set.singleton fp, Map.empty) -- Missing cache. Add it to dirty files and compute FileCacheInfo. go fp (Just modTime') Nothing = do newFci <- calcFci modTime' fp return (Set.singleton fp, Map.singleton fp newFci) -- | Returns entries to add to the build cache for any newly found unlisted modules addUnlistedToBuildCache :: (MonadIO m, MonadReader env m, MonadMask m, MonadLogger m, HasEnvConfig env) => ModTime -> Package -> Path Abs File -> Map FilePath a -> m ([Map FilePath FileCacheInfo], [PackageWarning]) addUnlistedToBuildCache preBuildTime pkg cabalFP buildCache = do (files,warnings) <- getPackageFilesSimple pkg cabalFP let newFiles = Set.toList $ Set.map toFilePath files `Set.difference` Map.keysSet buildCache addBuildCache <- mapM addFileToCache newFiles return (addBuildCache, warnings) where addFileToCache fp = do mmodTime <- getModTimeMaybe fp case mmodTime of Nothing -> return Map.empty Just modTime' -> if modTime' < preBuildTime then do newFci <- calcFci modTime' fp return (Map.singleton fp newFci) else return Map.empty -- | Gets list of Paths for files in a package getPackageFilesSimple :: (MonadIO m, MonadReader env m, MonadMask m, MonadLogger m, HasEnvConfig env) => Package -> Path Abs File -> m (Set (Path Abs File), [PackageWarning]) getPackageFilesSimple pkg cabalFP = do (_,compFiles,cabalFiles,warnings) <- getPackageFiles (packageFiles pkg) cabalFP return ( Set.map dotCabalGetPath (mconcat (M.elems compFiles)) <> cabalFiles , warnings) -- | Get file modification time, if it exists. getModTimeMaybe :: MonadIO m => FilePath -> m (Maybe ModTime) getModTimeMaybe fp = liftIO (catch (liftM (Just . modTime) (D.getModificationTime fp)) (\e -> if isDoesNotExistError e then return Nothing else throwM e)) -- | Create FileCacheInfo for a file. calcFci :: MonadIO m => ModTime -> FilePath -> m FileCacheInfo calcFci modTime' fp = liftIO $ withBinaryFile fp ReadMode $ \h -> do (size, digest) <- CB.sourceHandle h $$ getZipSink ((,) <$> ZipSink (CL.fold (\x y -> x + fromIntegral (S.length y)) 0) <*> ZipSink sinkHash) return FileCacheInfo { fciModTime = modTime' , fciSize = size , fciHash = toBytes (digest :: Digest SHA256) } checkComponentsBuildable :: MonadThrow m => [LocalPackage] -> m () checkComponentsBuildable lps = unless (null unbuildable) $ throwM $ SomeTargetsNotBuildable unbuildable where unbuildable = [ (packageName (lpPackage lp), c) | lp <- lps , c <- Set.toList (lpUnbuildable lp) ] getDefaultPackageConfig :: (MonadIO m, MonadReader env m, HasEnvConfig env) => m PackageConfig getDefaultPackageConfig = do econfig <- asks getEnvConfig bconfig <- asks getBuildConfig return PackageConfig { packageConfigEnableTests = False , packageConfigEnableBenchmarks = False , packageConfigFlags = M.empty , packageConfigGhcOptions = [] , packageConfigCompilerVersion = envConfigCompilerVersion econfig , packageConfigPlatform = configPlatform $ getConfig bconfig } -- | Get 'PackageConfig' for package given its name. getPackageConfig :: (MonadIO m, MonadReader env m, HasEnvConfig env) => BuildOptsCLI -> PackageName -> Bool -> Bool -> m PackageConfig getPackageConfig boptsCli name isTarget isLocal = do econfig <- asks getEnvConfig bconfig <- asks getBuildConfig return PackageConfig { packageConfigEnableTests = False , packageConfigEnableBenchmarks = False , packageConfigFlags = getLocalFlags bconfig boptsCli name , packageConfigGhcOptions = getGhcOptions bconfig boptsCli name isTarget isLocal , packageConfigCompilerVersion = envConfigCompilerVersion econfig , packageConfigPlatform = configPlatform $ getConfig bconfig } stack-1.1.2/src/Stack/Build/Target.hs0000644000000000000000000003251412711161622015467 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} -- | Parsing command line targets module Stack.Build.Target ( -- * Types ComponentName , UnresolvedComponent (..) , RawTarget (..) , LocalPackageView (..) , SimpleTarget (..) , NeedTargets (..) -- * Parsers , parseRawTarget , parseTargets ) where import Control.Applicative import Control.Arrow (second) import Control.Monad.Catch (MonadCatch, throwM) import Control.Monad.IO.Class import Data.Either (partitionEithers) import Data.Foldable import Data.List.Extra (groupSort) import Data.List.NonEmpty (NonEmpty((:|))) import qualified Data.List.NonEmpty as NonEmpty import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (mapMaybe) import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Path import Path.Extra (rejectMissingDir) import Path.IO import Prelude hiding (concat, concatMap) -- Fix redundant import warnings import Stack.Types -- | The name of a component, which applies to executables, test suites, and benchmarks type ComponentName = Text newtype RawInput = RawInput { unRawInput :: Text } -- | Either a fully resolved component, or a component name that could be -- either an executable, test, or benchmark data UnresolvedComponent = ResolvedComponent !NamedComponent | UnresolvedComponent !ComponentName deriving (Show, Eq, Ord) -- | Raw command line input, without checking against any databases or list of -- locals. Does not deal with directories data RawTarget (a :: RawTargetType) where RTPackageComponent :: !PackageName -> !UnresolvedComponent -> RawTarget a RTComponent :: !ComponentName -> RawTarget a RTPackage :: !PackageName -> RawTarget a RTPackageIdentifier :: !PackageIdentifier -> RawTarget 'HasIdents deriving instance Show (RawTarget a) deriving instance Eq (RawTarget a) deriving instance Ord (RawTarget a) data RawTargetType = HasIdents | NoIdents -- | If this function returns @Nothing@, the input should be treated as a -- directory. parseRawTarget :: Text -> Maybe (RawTarget 'HasIdents) parseRawTarget t = (RTPackageIdentifier <$> parsePackageIdentifierFromString s) <|> (RTPackage <$> parsePackageNameFromString s) <|> (RTComponent <$> T.stripPrefix ":" t) <|> parsePackageComponent where s = T.unpack t parsePackageComponent = case T.splitOn ":" t of [pname, "lib"] | Just pname' <- parsePackageNameFromString (T.unpack pname) -> Just $ RTPackageComponent pname' $ ResolvedComponent CLib [pname, cname] | Just pname' <- parsePackageNameFromString (T.unpack pname) -> Just $ RTPackageComponent pname' $ UnresolvedComponent cname [pname, typ, cname] | Just pname' <- parsePackageNameFromString (T.unpack pname) , Just wrapper <- parseCompType typ -> Just $ RTPackageComponent pname' $ ResolvedComponent $ wrapper cname _ -> Nothing parseCompType t' = case t' of "exe" -> Just CExe "test" -> Just CTest "bench" -> Just CBench _ -> Nothing -- | A view of a local package needed for resolving components data LocalPackageView = LocalPackageView { lpvVersion :: !Version , lpvRoot :: !(Path Abs Dir) , lpvCabalFP :: !(Path Abs File) , lpvComponents :: !(Set NamedComponent) , lpvExtraDep :: !TreatLikeExtraDep } -- | Same as @parseRawTarget@, but also takes directories into account. parseRawTargetDirs :: (MonadIO m, MonadCatch m) => Path Abs Dir -- ^ current directory -> Map PackageName LocalPackageView -> Text -> m (Either Text [(RawInput, RawTarget 'HasIdents)]) parseRawTargetDirs root locals t = case parseRawTarget t of Just rt -> return $ Right [(ri, rt)] Nothing -> do mdir <- forgivingAbsence (resolveDir root (T.unpack t)) >>= rejectMissingDir case mdir of Nothing -> return $ Left $ "Directory not found: " `T.append` t Just dir -> case mapMaybe (childOf dir) $ Map.toList locals of [] -> return $ Left $ "No local directories found as children of " `T.append` t names -> return $ Right $ map ((ri, ) . RTPackage) names where ri = RawInput t childOf dir (name, lpv) = if (dir == lpvRoot lpv || isParentOf dir (lpvRoot lpv)) && not (lpvExtraDep lpv) then Just name else Nothing data SimpleTarget = STUnknown | STNonLocal | STLocalComps !(Set NamedComponent) | STLocalAll deriving (Show, Eq, Ord) resolveIdents :: Map PackageName Version -- ^ snapshot -> Map PackageName Version -- ^ extra deps -> Map PackageName LocalPackageView -> (RawInput, RawTarget 'HasIdents) -> Either Text ((RawInput, RawTarget 'NoIdents), Map PackageName Version) resolveIdents _ _ _ (ri, RTPackageComponent x y) = Right ((ri, RTPackageComponent x y), Map.empty) resolveIdents _ _ _ (ri, RTComponent x) = Right ((ri, RTComponent x), Map.empty) resolveIdents _ _ _ (ri, RTPackage x) = Right ((ri, RTPackage x), Map.empty) resolveIdents snap extras locals (ri, RTPackageIdentifier (PackageIdentifier name version)) = fmap ((ri, RTPackage name), ) newExtras where newExtras = case (Map.lookup name locals, mfound) of -- Error if it matches a local package, pkg idents not -- supported for local. (Just _, _) -> Left $ T.concat [ packageNameText name , " target has a specific version number, but it is a local package." , "\nTo avoid confusion, we will not install the specified version or build the local one." , "\nTo build the local package, specify the target without an explicit version." ] -- If the found version matches, no need for an extra-dep. (_, Just foundVersion) | foundVersion == version -> Right Map.empty -- Otherwise, if there is no specified version or a -- mismatch, add an extra-dep. _ -> Right $ Map.singleton name version mfound = asum (map (Map.lookup name) [extras, snap]) resolveRawTarget :: Map PackageName Version -- ^ snapshot -> Map PackageName Version -- ^ extra deps -> Map PackageName LocalPackageView -> (RawInput, RawTarget 'NoIdents) -> Either Text (PackageName, (RawInput, SimpleTarget)) resolveRawTarget snap extras locals (ri, rt) = go rt where go (RTPackageComponent name ucomp) = case Map.lookup name locals of Nothing -> Left $ T.pack $ "Unknown local package: " ++ packageNameString name Just lpv -> case ucomp of ResolvedComponent comp | comp `Set.member` lpvComponents lpv -> Right (name, (ri, STLocalComps $ Set.singleton comp)) | otherwise -> Left $ T.pack $ concat [ "Component " , show comp , " does not exist in package " , packageNameString name ] UnresolvedComponent comp -> case filter (isCompNamed comp) $ Set.toList $ lpvComponents lpv of [] -> Left $ T.concat [ "Component " , comp , " does not exist in package " , T.pack $ packageNameString name ] [x] -> Right (name, (ri, STLocalComps $ Set.singleton x)) matches -> Left $ T.concat [ "Ambiguous component name " , comp , " for package " , T.pack $ packageNameString name , ": " , T.pack $ show matches ] go (RTComponent cname) = let allPairs = concatMap (\(name, lpv) -> map (name,) $ Set.toList $ lpvComponents lpv) (Map.toList locals) in case filter (isCompNamed cname . snd) allPairs of [] -> Left $ "Could not find a component named " `T.append` cname [(name, comp)] -> Right (name, (ri, STLocalComps $ Set.singleton comp)) matches -> Left $ T.concat [ "Ambiugous component name " , cname , ", matches: " , T.pack $ show matches ] go (RTPackage name) = case Map.lookup name locals of Just _lpv -> Right (name, (ri, STLocalAll)) Nothing -> case Map.lookup name extras of Just _ -> Right (name, (ri, STNonLocal)) Nothing -> case Map.lookup name snap of Just _ -> Right (name, (ri, STNonLocal)) Nothing -> Right (name, (ri, STUnknown)) isCompNamed :: Text -> NamedComponent -> Bool isCompNamed _ CLib = False isCompNamed t1 (CExe t2) = t1 == t2 isCompNamed t1 (CTest t2) = t1 == t2 isCompNamed t1 (CBench t2) = t1 == t2 simplifyTargets :: [(PackageName, (RawInput, SimpleTarget))] -> ([Text], Map PackageName SimpleTarget) simplifyTargets = foldMap go . collect where go :: (PackageName, NonEmpty (RawInput, SimpleTarget)) -> ([Text], Map PackageName SimpleTarget) go (name, (_, st) :| []) = ([], Map.singleton name st) go (name, pairs) = case partitionEithers $ map (getLocalComp . snd) (NonEmpty.toList pairs) of ([], comps) -> ([], Map.singleton name $ STLocalComps $ Set.unions comps) _ -> let err = T.pack $ concat [ "Overlapping targets provided for package " , packageNameString name , ": " , show $ map (unRawInput . fst) (NonEmpty.toList pairs) ] in ([err], Map.empty) collect :: Ord a => [(a, b)] -> [(a, NonEmpty b)] collect = map (second NonEmpty.fromList) . groupSort getLocalComp (STLocalComps comps) = Right comps getLocalComp _ = Left () -- | Need targets, e.g. `stack build` or allow none? data NeedTargets = NeedTargets | AllowNoTargets parseTargets :: (MonadCatch m, MonadIO m) => NeedTargets -- ^ need at least one target -> Bool -- ^ using implicit global project? -> Map PackageName Version -- ^ snapshot -> Map PackageName Version -- ^ extra deps -> Map PackageName LocalPackageView -> Path Abs Dir -- ^ current directory -> [Text] -- ^ command line targets -> m (Map PackageName Version, Map PackageName SimpleTarget) parseTargets needTargets implicitGlobal snap extras locals currDir textTargets' = do let nonExtraDeps = Map.keys $ Map.filter (not . lpvExtraDep) locals textTargets = if null textTargets' then map (T.pack . packageNameString) nonExtraDeps else textTargets' erawTargets <- mapM (parseRawTargetDirs currDir locals) textTargets let (errs1, rawTargets) = partitionEithers erawTargets (errs2, unzip -> (rawTargets', newExtras)) = partitionEithers $ map (resolveIdents snap extras locals) $ concat rawTargets (errs3, targetTypes) = partitionEithers $ map (resolveRawTarget snap extras locals) rawTargets' (errs4, targets) = simplifyTargets targetTypes errs = concat [errs1, errs2, errs3, errs4] if null errs then if Map.null targets then case needTargets of AllowNoTargets -> return (Map.empty, Map.empty) NeedTargets | null textTargets' && implicitGlobal -> throwM $ TargetParseException ["The specified targets matched no packages.\nPerhaps you need to run 'stack init'?"] | null textTargets' && null nonExtraDeps -> throwM $ TargetParseException ["The project contains no local packages (packages not marked with 'extra-dep')"] | otherwise -> throwM $ TargetParseException ["The specified targets matched no packages"] else return (Map.unions newExtras, targets) else throwM $ TargetParseException errs stack-1.1.2/src/Stack/BuildPlan.hs0000644000000000000000000013471012717707440015067 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} -- | Resolving a build plan for a set of packages in a given Stackage -- snapshot. module Stack.BuildPlan ( BuildPlanException (..) , BuildPlanCheck (..) , checkSnapBuildPlan , DepError(..) , DepErrors , gpdPackageDeps , gpdPackages , gpdPackageName , MiniBuildPlan(..) , MiniPackageInfo(..) , loadResolver , loadMiniBuildPlan , removeSrcPkgDefaultFlags , resolveBuildPlan , selectBestSnapshot , getToolMap , shadowMiniBuildPlan , showItems , showPackageFlags , parseCustomMiniBuildPlan ) where import Control.Applicative import Control.Exception (assert) import Control.Monad (liftM, forM, unless) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (asks) import Control.Monad.State.Strict (State, execState, get, modify, put) import Control.Monad.Trans.Control (MonadBaseControl) import qualified Crypto.Hash.SHA256 as SHA256 import Data.Aeson.Extended (WithJSONWarnings(..), logJSONWarnings) import Data.Binary.VersionTagged (taggedDecodeOrLoad, decodeFileOrFailDeep, taggedEncodeFile) import qualified Data.ByteString as S import qualified Data.ByteString.Base64.URL as B64URL import qualified Data.ByteString.Char8 as S8 import Data.Either (partitionEithers) import qualified Data.Foldable as F import qualified Data.HashSet as HashSet import Data.List (intercalate) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (fromMaybe, mapMaybe, isNothing) import Data.Monoid import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import qualified Data.Traversable as Tr import Data.Typeable (Typeable) import Data.Yaml (decodeEither', decodeFileEither) import qualified Distribution.Package as C import Distribution.PackageDescription (GenericPackageDescription, flagDefault, flagManual, flagName, genPackageFlags, executables, exeName, library, libBuildInfo, buildable) import qualified Distribution.PackageDescription as C import Distribution.System (Platform) import Distribution.Text (display) import qualified Distribution.Version as C import Network.HTTP.Client (checkStatus) import Network.HTTP.Download import Network.HTTP.Types (Status(..)) import Path import Path.IO import Prelude -- Fix AMP warning import Stack.Constants import Stack.Fetch import Stack.Package import Stack.PackageIndex import Stack.Types import Stack.Types.StackT data BuildPlanException = UnknownPackages (Path Abs File) -- stack.yaml file (Map PackageName (Maybe Version, Set PackageName)) -- truly unknown (Map PackageName (Set PackageIdentifier)) -- shadowed | SnapshotNotFound SnapName | FilepathInDownloadedSnapshot T.Text | NeitherCompilerOrResolverSpecified T.Text deriving (Typeable) instance Exception BuildPlanException instance Show BuildPlanException where show (SnapshotNotFound snapName) = unlines [ "SnapshotNotFound " ++ snapName' , "Non existing resolver: " ++ snapName' ++ "." , "For a complete list of available snapshots see https://www.stackage.org/snapshots" ] where snapName' = show $ renderSnapName snapName show (UnknownPackages stackYaml unknown shadowed) = unlines $ unknown' ++ shadowed' where unknown' :: [String] unknown' | Map.null unknown = [] | otherwise = concat [ ["The following packages do not exist in the build plan:"] , map go (Map.toList unknown) , case mapMaybe goRecommend $ Map.toList unknown of [] -> [] rec -> ("Recommended action: modify the extra-deps field of " ++ toFilePath stackYaml ++ " to include the following:") : (rec ++ ["Note: further dependencies may need to be added"]) , case mapMaybe getNoKnown $ Map.toList unknown of [] -> [] noKnown -> [ "There are no known versions of the following packages:" , intercalate ", " $ map packageNameString noKnown ] ] where go (dep, (_, users)) | Set.null users = packageNameString dep go (dep, (_, users)) = concat [ packageNameString dep , " (used by " , intercalate ", " $ map packageNameString $ Set.toList users , ")" ] goRecommend (name, (Just version, _)) = Just $ "- " ++ packageIdentifierString (PackageIdentifier name version) goRecommend (_, (Nothing, _)) = Nothing getNoKnown (name, (Nothing, _)) = Just name getNoKnown (_, (Just _, _)) = Nothing shadowed' :: [String] shadowed' | Map.null shadowed = [] | otherwise = concat [ ["The following packages are shadowed by local packages:"] , map go (Map.toList shadowed) , ["Recommended action: modify the extra-deps field of " ++ toFilePath stackYaml ++ " to include the following:"] , extraDeps , ["Note: further dependencies may need to be added"] ] where go (dep, users) | Set.null users = concat [ packageNameString dep , " (internal stack error: this should never be null)" ] go (dep, users) = concat [ packageNameString dep , " (used by " , intercalate ", " $ map (packageNameString . packageIdentifierName) $ Set.toList users , ")" ] extraDeps = map (\ident -> "- " ++ packageIdentifierString ident) $ Set.toList $ Set.unions $ Map.elems shadowed show (FilepathInDownloadedSnapshot url) = unlines [ "Downloaded snapshot specified a 'resolver: { location: filepath }' " , "field, but filepaths are not allowed in downloaded snapshots.\n" , "Filepath specified: " ++ T.unpack url ] show (NeitherCompilerOrResolverSpecified url) = "Failed to load custom snapshot at " ++ T.unpack url ++ ", because no 'compiler' or 'resolver' is specified." -- | Determine the necessary packages to install to have the given set of -- packages available. -- -- This function will not provide test suite and benchmark dependencies. -- -- This may fail if a target package is not present in the @BuildPlan@. resolveBuildPlan :: (MonadThrow m, MonadIO m, MonadReader env m, HasBuildConfig env, MonadLogger m, HasHttpManager env, MonadBaseControl IO m,MonadCatch m) => MiniBuildPlan -> (PackageName -> Bool) -- ^ is it shadowed by a local package? -> Map PackageName (Set PackageName) -- ^ required packages, and users of it -> m ( Map PackageName (Version, Map FlagName Bool) , Map PackageName (Set PackageName) ) resolveBuildPlan mbp isShadowed packages | Map.null (rsUnknown rs) && Map.null (rsShadowed rs) = return (rsToInstall rs, rsUsedBy rs) | otherwise = do bconfig <- asks getBuildConfig caches <- getPackageCaches let maxVer = Map.fromListWith max $ map toTuple $ Map.keys caches unknown = flip Map.mapWithKey (rsUnknown rs) $ \ident x -> (Map.lookup ident maxVer, x) throwM $ UnknownPackages (bcStackYaml bconfig) unknown (rsShadowed rs) where rs = getDeps mbp isShadowed packages data ResolveState = ResolveState { rsVisited :: Map PackageName (Set PackageName) -- ^ set of shadowed dependencies , rsUnknown :: Map PackageName (Set PackageName) , rsShadowed :: Map PackageName (Set PackageIdentifier) , rsToInstall :: Map PackageName (Version, Map FlagName Bool) , rsUsedBy :: Map PackageName (Set PackageName) } toMiniBuildPlan :: (MonadIO m, MonadLogger m, MonadReader env m, HasHttpManager env, MonadMask m, HasConfig env, MonadBaseControl IO m) => CompilerVersion -- ^ Compiler version -> Map PackageName Version -- ^ cores -> Map PackageName (Version, Map FlagName Bool, [Text], Maybe GitSHA1) -- ^ non-core packages -> m MiniBuildPlan toMiniBuildPlan compilerVersion corePackages packages = do -- Determine the dependencies of all of the packages in the build plan. We -- handle core packages specially, because some of them will not be in the -- package index. For those, we allow missing packages to exist, and then -- remove those from the list of dependencies, since there's no way we'll -- ever reinstall them anyway. (cores, missingCores) <- addDeps True compilerVersion $ fmap (, Map.empty, [], Nothing) corePackages (extras, missing) <- addDeps False compilerVersion packages assert (Set.null missing) $ return MiniBuildPlan { mbpCompilerVersion = compilerVersion , mbpPackages = Map.unions [ fmap (removeMissingDeps (Map.keysSet cores)) cores , extras , Map.fromList $ map goCore $ Set.toList missingCores ] } where goCore (PackageIdentifier name version) = (name, MiniPackageInfo { mpiVersion = version , mpiFlags = Map.empty , mpiGhcOptions = [] , mpiPackageDeps = Set.empty , mpiToolDeps = Set.empty , mpiExes = Set.empty , mpiHasLibrary = True , mpiGitSHA1 = Nothing }) removeMissingDeps cores mpi = mpi { mpiPackageDeps = Set.intersection cores (mpiPackageDeps mpi) } -- | Add in the resolved dependencies from the package index addDeps :: (MonadIO m, MonadLogger m, MonadReader env m, HasHttpManager env, MonadMask m, HasConfig env, MonadBaseControl IO m) => Bool -- ^ allow missing -> CompilerVersion -- ^ Compiler version -> Map PackageName (Version, Map FlagName Bool, [Text], Maybe GitSHA1) -> m (Map PackageName MiniPackageInfo, Set PackageIdentifier) addDeps allowMissing compilerVersion toCalc = do menv <- getMinimalEnvOverride platform <- asks $ configPlatform . getConfig (resolvedMap, missingIdents) <- if allowMissing then do (missingNames, missingIdents, m) <- resolvePackagesAllowMissing shaMap Set.empty assert (Set.null missingNames) $ return (m, missingIdents) else do m <- resolvePackages menv shaMap Set.empty return (m, Set.empty) let byIndex = Map.fromListWith (++) $ flip map (Map.toList resolvedMap) $ \(ident, rp) -> let (cache, ghcOptions, sha) = case Map.lookup (packageIdentifierName ident) toCalc of Nothing -> (Map.empty, [], Nothing) Just (_, x, y, z) -> (x, y, z) in (indexName $ rpIndex rp, [( ident , rpCache rp , sha , (cache, ghcOptions, sha) )]) res <- forM (Map.toList byIndex) $ \(indexName', pkgs) -> withCabalFiles indexName' pkgs $ \ident (flags, ghcOptions, mgitSha) cabalBS -> do (_warnings,gpd) <- readPackageUnresolvedBS Nothing cabalBS let packageConfig = PackageConfig { packageConfigEnableTests = False , packageConfigEnableBenchmarks = False , packageConfigFlags = flags , packageConfigGhcOptions = ghcOptions , packageConfigCompilerVersion = compilerVersion , packageConfigPlatform = platform } name = packageIdentifierName ident pd = resolvePackageDescription packageConfig gpd exes = Set.fromList $ map (ExeName . T.pack . exeName) $ executables pd notMe = Set.filter (/= name) . Map.keysSet return (name, MiniPackageInfo { mpiVersion = packageIdentifierVersion ident , mpiFlags = flags , mpiGhcOptions = ghcOptions , mpiPackageDeps = notMe $ packageDependencies pd , mpiToolDeps = Map.keysSet $ packageToolDependencies pd , mpiExes = exes , mpiHasLibrary = maybe False (buildable . libBuildInfo) (library pd) , mpiGitSHA1 = mgitSha }) return (Map.fromList $ concat res, missingIdents) where shaMap = Map.fromList $ map (\(n, (v, _f, _ghcOptions, gitsha)) -> (PackageIdentifier n v, gitsha)) $ Map.toList toCalc -- | Resolve all packages necessary to install for the needed packages. getDeps :: MiniBuildPlan -> (PackageName -> Bool) -- ^ is it shadowed by a local package? -> Map PackageName (Set PackageName) -> ResolveState getDeps mbp isShadowed packages = execState (mapM_ (uncurry goName) $ Map.toList packages) ResolveState { rsVisited = Map.empty , rsUnknown = Map.empty , rsShadowed = Map.empty , rsToInstall = Map.empty , rsUsedBy = Map.empty } where toolMap = getToolMap mbp -- | Returns a set of shadowed packages we depend on. goName :: PackageName -> Set PackageName -> State ResolveState (Set PackageName) goName name users = do -- Even though we could check rsVisited first and short-circuit things -- earlier, lookup in mbpPackages first so that we can produce more -- usable error information on missing dependencies rs <- get put rs { rsUsedBy = Map.insertWith Set.union name users $ rsUsedBy rs } case Map.lookup name $ mbpPackages mbp of Nothing -> do modify $ \rs' -> rs' { rsUnknown = Map.insertWith Set.union name users $ rsUnknown rs' } return Set.empty Just mpi -> case Map.lookup name (rsVisited rs) of Just shadowed -> return shadowed Nothing -> do put rs { rsVisited = Map.insert name Set.empty $ rsVisited rs } let depsForTools = Set.unions $ mapMaybe (flip Map.lookup toolMap) (Set.toList $ mpiToolDeps mpi) let deps = Set.filter (/= name) (mpiPackageDeps mpi <> depsForTools) shadowed <- fmap F.fold $ Tr.forM (Set.toList deps) $ \dep -> if isShadowed dep then do modify $ \rs' -> rs' { rsShadowed = Map.insertWith Set.union dep (Set.singleton $ PackageIdentifier name (mpiVersion mpi)) (rsShadowed rs') } return $ Set.singleton dep else do shadowed <- goName dep (Set.singleton name) let m = Map.fromSet (\_ -> Set.singleton $ PackageIdentifier name (mpiVersion mpi)) shadowed modify $ \rs' -> rs' { rsShadowed = Map.unionWith Set.union m $ rsShadowed rs' } return shadowed modify $ \rs' -> rs' { rsToInstall = Map.insert name (mpiVersion mpi, mpiFlags mpi) $ rsToInstall rs' , rsVisited = Map.insert name shadowed $ rsVisited rs' } return shadowed -- | Map from tool name to package providing it getToolMap :: MiniBuildPlan -> Map Text (Set PackageName) getToolMap mbp = Map.unionsWith Set.union {- We no longer do this, following discussion at: https://github.com/commercialhaskell/stack/issues/308#issuecomment-112076704 -- First grab all of the package names, for times where a build tool is -- identified by package name $ Map.fromList (map (packageNameByteString &&& Set.singleton) (Map.keys ps)) -} -- And then get all of the explicit executable names $ concatMap goPair (Map.toList ps) where ps = mbpPackages mbp goPair (pname, mpi) = map (flip Map.singleton (Set.singleton pname) . unExeName) $ Set.toList $ mpiExes mpi loadResolver :: (MonadIO m, MonadLogger m, MonadReader env m, HasHttpManager env, HasConfig env, HasGHCVariant env, MonadBaseControl IO m, MonadMask m) => Maybe (Path Abs File) -> Resolver -> m (MiniBuildPlan, LoadedResolver) loadResolver mconfigPath resolver = case resolver of ResolverSnapshot snap -> liftM (, ResolverSnapshot snap) $ loadMiniBuildPlan snap -- TODO(mgsloan): Not sure what this FIXME means -- FIXME instead of passing the stackYaml dir we should maintain -- the file URL in the custom resolver always relative to stackYaml. ResolverCustom name url -> do (mbp, hash) <- parseCustomMiniBuildPlan mconfigPath url return (mbp, ResolverCustomLoaded name url hash) ResolverCompiler compiler -> return ( MiniBuildPlan { mbpCompilerVersion = compiler , mbpPackages = mempty } , ResolverCompiler compiler ) -- | Load up a 'MiniBuildPlan', preferably from cache loadMiniBuildPlan :: (MonadIO m, MonadLogger m, MonadReader env m, HasHttpManager env, HasConfig env, HasGHCVariant env, MonadBaseControl IO m, MonadMask m) => SnapName -> m MiniBuildPlan loadMiniBuildPlan name = do path <- configMiniBuildPlanCache name taggedDecodeOrLoad path $ liftM buildPlanFixes $ do bp <- loadBuildPlan name toMiniBuildPlan (siCompilerVersion $ bpSystemInfo bp) (siCorePackages $ bpSystemInfo bp) (fmap goPP $ bpPackages bp) where goPP pp = ( ppVersion pp , pcFlagOverrides $ ppConstraints pp -- TODO: store ghc options in BuildPlan? , [] , ppCabalFileInfo pp >>= fmap (GitSHA1 . encodeUtf8) . Map.lookup "GitSHA1" . cfiHashes ) -- | Some hard-coded fixes for build plans, hopefully to be irrelevant over -- time. buildPlanFixes :: MiniBuildPlan -> MiniBuildPlan buildPlanFixes mbp = mbp { mbpPackages = Map.fromList $ map go $ Map.toList $ mbpPackages mbp } where go (name, mpi) = (name, mpi { mpiFlags = goF (packageNameString name) (mpiFlags mpi) }) goF "persistent-sqlite" = Map.insert $(mkFlagName "systemlib") False goF "yaml" = Map.insert $(mkFlagName "system-libyaml") False goF _ = id -- | Load the 'BuildPlan' for the given snapshot. Will load from a local copy -- if available, otherwise downloading from Github. loadBuildPlan :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader env m, HasHttpManager env, HasConfig env) => SnapName -> m BuildPlan loadBuildPlan name = do env <- ask let stackage = getStackRoot env file' <- parseRelFile $ T.unpack file let fp = buildPlanDir stackage file' $logDebug $ "Decoding build plan from: " <> T.pack (toFilePath fp) eres <- liftIO $ decodeFileEither $ toFilePath fp case eres of Right bp -> return bp Left e -> do $logDebug $ "Decoding build plan from file failed: " <> T.pack (show e) ensureDir (parent fp) url <- buildBuildPlanUrl name file req <- parseUrl $ T.unpack url $logSticky $ "Downloading " <> renderSnapName name <> " build plan ..." $logDebug $ "Downloading build plan from: " <> url _ <- redownload req { checkStatus = handle404 } fp $logStickyDone $ "Downloaded " <> renderSnapName name <> " build plan." liftIO (decodeFileEither $ toFilePath fp) >>= either throwM return where file = renderSnapName name <> ".yaml" handle404 (Status 404 _) _ _ = Just $ SomeException $ SnapshotNotFound name handle404 _ _ _ = Nothing buildBuildPlanUrl :: (MonadReader env m, HasConfig env) => SnapName -> Text -> m Text buildBuildPlanUrl name file = do urls <- asks (configUrls . getConfig) return $ case name of LTS _ _ -> urlsLtsBuildPlans urls <> "/" <> file Nightly _ -> urlsNightlyBuildPlans urls <> "/" <> file gpdPackages :: [GenericPackageDescription] -> Map PackageName Version gpdPackages gpds = Map.fromList $ map (fromCabalIdent . C.package . C.packageDescription) gpds where fromCabalIdent (C.PackageIdentifier name version) = (fromCabalPackageName name, fromCabalVersion version) gpdPackageName :: GenericPackageDescription -> PackageName gpdPackageName = fromCabalPackageName . C.pkgName . C.package . C.packageDescription gpdPackageDeps :: GenericPackageDescription -> CompilerVersion -> Platform -> Map FlagName Bool -> Map PackageName VersionRange gpdPackageDeps gpd cv platform flags = Map.filterWithKey (const . (/= name)) (packageDependencies pkgDesc) where name = gpdPackageName gpd pkgDesc = resolvePackageDescription pkgConfig gpd pkgConfig = PackageConfig { packageConfigEnableTests = True , packageConfigEnableBenchmarks = True , packageConfigFlags = flags , packageConfigGhcOptions = [] , packageConfigCompilerVersion = cv , packageConfigPlatform = platform } -- Remove any src package flags having default values -- Remove any package entries with no flags set removeSrcPkgDefaultFlags :: [C.GenericPackageDescription] -> Map PackageName (Map FlagName Bool) -> Map PackageName (Map FlagName Bool) removeSrcPkgDefaultFlags gpds flags = let defaults = Map.unions (map gpdDefaultFlags gpds) flags' = Map.differenceWith removeSame flags defaults in Map.filter (not . Map.null) flags' where removeSame f1 f2 = let diff v v' = if v == v' then Nothing else Just v in Just $ Map.differenceWith diff f1 f2 gpdDefaultFlags gpd = let tuples = map getDefault (C.genPackageFlags gpd) in Map.singleton (gpdPackageName gpd) (Map.fromList tuples) flagName' = fromCabalFlagName . C.flagName getDefault f | C.flagDefault f = (flagName' f, True) | otherwise = (flagName' f, False) -- | Find the set of @FlagName@s necessary to get the given -- @GenericPackageDescription@ to compile against the given @BuildPlan@. Will -- only modify non-manual flags, and will prefer default values for flags. -- Returns the plan which produces least number of dep errors selectPackageBuildPlan :: Platform -> CompilerVersion -> Map PackageName Version -> GenericPackageDescription -> (Map PackageName (Map FlagName Bool), DepErrors) selectPackageBuildPlan platform compiler pool gpd = (selectPlan . limitSearchSpace . NonEmpty.map makePlan) flagCombinations where selectPlan :: NonEmpty (a, DepErrors) -> (a, DepErrors) selectPlan = F.foldr1 fewerErrors where fewerErrors p1 p2 | nErrors p1 == 0 = p1 | nErrors p1 <= nErrors p2 = p1 | otherwise = p2 where nErrors = Map.size . snd -- Avoid exponential complexity in flag combinations making us sad pandas. -- See: https://github.com/commercialhaskell/stack/issues/543 limitSearchSpace :: NonEmpty a -> NonEmpty a limitSearchSpace (x :| xs) = x :| take (maxFlagCombinations - 1) xs where maxFlagCombinations = 128 makePlan :: [(FlagName, Bool)] -> (Map PackageName (Map FlagName Bool), DepErrors) makePlan flags = checkPackageBuildPlan platform compiler pool (Map.fromList flags) gpd flagCombinations :: NonEmpty [(FlagName, Bool)] flagCombinations = mapM getOptions (genPackageFlags gpd) where getOptions :: C.Flag -> NonEmpty (FlagName, Bool) getOptions f | flagManual f = (fname, flagDefault f) :| [] | flagDefault f = (fname, True) :| [(fname, False)] | otherwise = (fname, False) :| [(fname, True)] where fname = (fromCabalFlagName . flagName) f -- | Check whether with the given set of flags a package's dependency -- constraints can be satisfied against a given build plan or pool of packages. checkPackageBuildPlan :: Platform -> CompilerVersion -> Map PackageName Version -> Map FlagName Bool -> GenericPackageDescription -> (Map PackageName (Map FlagName Bool), DepErrors) checkPackageBuildPlan platform compiler pool flags gpd = (Map.singleton pkg flags, errs) where pkg = gpdPackageName gpd errs = checkPackageDeps pkg constraints pool constraints = gpdPackageDeps gpd compiler platform flags -- | Checks if the given package dependencies can be satisfied by the given set -- of packages. Will fail if a package is either missing or has a version -- outside of the version range. checkPackageDeps :: PackageName -- ^ package using dependencies, for constructing DepErrors -> Map PackageName VersionRange -- ^ dependency constraints -> Map PackageName Version -- ^ Available package pool or index -> DepErrors checkPackageDeps myName deps packages = Map.unionsWith combineDepError $ map go $ Map.toList deps where go :: (PackageName, VersionRange) -> DepErrors go (name, range) = case Map.lookup name packages of Nothing -> Map.singleton name DepError { deVersion = Nothing , deNeededBy = Map.singleton myName range } Just v | withinRange v range -> Map.empty | otherwise -> Map.singleton name DepError { deVersion = Just v , deNeededBy = Map.singleton myName range } type DepErrors = Map PackageName DepError data DepError = DepError { deVersion :: !(Maybe Version) , deNeededBy :: !(Map PackageName VersionRange) } deriving Show -- | Combine two 'DepError's for the same 'Version'. combineDepError :: DepError -> DepError -> DepError combineDepError (DepError a x) (DepError b y) = assert (a == b) $ DepError a (Map.unionWith C.intersectVersionRanges x y) -- | Given a bundle of packages (a list of @GenericPackageDescriptions@'s) to -- build and an available package pool (snapshot) check whether the bundle's -- dependencies can be satisfied. If flags is passed as Nothing flag settings -- will be chosen automatically. checkBundleBuildPlan :: Platform -> CompilerVersion -> Map PackageName Version -> Maybe (Map PackageName (Map FlagName Bool)) -> [GenericPackageDescription] -> (Map PackageName (Map FlagName Bool), DepErrors) checkBundleBuildPlan platform compiler pool flags gpds = (Map.unionsWith dupError (map fst plans) , Map.unionsWith combineDepError (map snd plans)) where plans = map (pkgPlan flags) gpds pkgPlan Nothing gpd = selectPackageBuildPlan platform compiler pool' gpd pkgPlan (Just f) gpd = checkPackageBuildPlan platform compiler pool' (flags' f gpd) gpd flags' f gpd = maybe Map.empty id (Map.lookup (gpdPackageName gpd) f) pool' = Map.union (gpdPackages gpds) pool dupError _ _ = error "Bug: Duplicate packages are not expected here" data BuildPlanCheck = BuildPlanCheckOk (Map PackageName (Map FlagName Bool)) | BuildPlanCheckPartial (Map PackageName (Map FlagName Bool)) DepErrors | BuildPlanCheckFail (Map PackageName (Map FlagName Bool)) DepErrors CompilerVersion -- | Compare 'BuildPlanCheck', where GT means a better plan. compareBuildPlanCheck :: BuildPlanCheck -> BuildPlanCheck -> Ordering compareBuildPlanCheck (BuildPlanCheckPartial _ e1) (BuildPlanCheckPartial _ e2) = -- Note: order of comparison flipped, since it's better to have fewer errors. compare (Map.size e2) (Map.size e1) compareBuildPlanCheck (BuildPlanCheckFail _ e1 _) (BuildPlanCheckFail _ e2 _) = let numUserPkgs e = Map.size $ Map.unions (Map.elems (fmap deNeededBy e)) in compare (numUserPkgs e2) (numUserPkgs e1) compareBuildPlanCheck BuildPlanCheckOk{} BuildPlanCheckOk{} = EQ compareBuildPlanCheck BuildPlanCheckOk{} BuildPlanCheckPartial{} = GT compareBuildPlanCheck BuildPlanCheckOk{} BuildPlanCheckFail{} = GT compareBuildPlanCheck BuildPlanCheckPartial{} BuildPlanCheckFail{} = GT compareBuildPlanCheck _ _ = LT instance Show BuildPlanCheck where show BuildPlanCheckOk {} = "" show (BuildPlanCheckPartial f e) = T.unpack $ showDepErrors f e show (BuildPlanCheckFail f e c) = T.unpack $ showCompilerErrors f e c -- | Check a set of 'GenericPackageDescription's and a set of flags against a -- given snapshot. Returns how well the snapshot satisfies the dependencies of -- the packages. checkSnapBuildPlan :: ( MonadIO m, MonadMask m, MonadLogger m, MonadReader env m , HasHttpManager env, HasConfig env, HasGHCVariant env , MonadBaseControl IO m) => [GenericPackageDescription] -> Maybe (Map PackageName (Map FlagName Bool)) -> SnapName -> m BuildPlanCheck checkSnapBuildPlan gpds flags snap = do platform <- asks (configPlatform . getConfig) mbp <- loadMiniBuildPlan snap let compiler = mbpCompilerVersion mbp snapPkgs = fmap mpiVersion $ mbpPackages mbp (f, errs) = checkBundleBuildPlan platform compiler snapPkgs flags gpds cerrs = compilerErrors compiler errs if Map.null errs then return $ BuildPlanCheckOk f else if Map.null cerrs then do return $ BuildPlanCheckPartial f errs else return $ BuildPlanCheckFail f cerrs compiler where compilerErrors compiler errs | whichCompiler compiler == Ghc = ghcErrors errs -- FIXME not sure how to handle ghcjs boot packages | otherwise = Map.empty isGhcWiredIn p _ = p `HashSet.member` wiredInPackages ghcErrors = Map.filterWithKey isGhcWiredIn -- | Find a snapshot and set of flags that is compatible with and matches as -- best as possible with the given 'GenericPackageDescription's. selectBestSnapshot :: ( MonadIO m, MonadMask m, MonadLogger m, MonadReader env m , HasHttpManager env, HasConfig env, HasGHCVariant env , MonadBaseControl IO m) => [GenericPackageDescription] -> NonEmpty SnapName -> m (SnapName, BuildPlanCheck) selectBestSnapshot gpds snaps = do $logInfo $ "Selecting the best among " <> T.pack (show (NonEmpty.length snaps)) <> " snapshots...\n" F.foldr1 go (NonEmpty.map getResult snaps) where go mold mnew = do old@(_snap, bpc) <- mold case bpc of BuildPlanCheckOk {} -> return old _ -> fmap (betterSnap old) mnew getResult snap = do result <- checkSnapBuildPlan gpds Nothing snap reportResult result snap return (snap, result) betterSnap (s1, r1) (s2, r2) | compareBuildPlanCheck r1 r2 /= LT = (s1, r1) | otherwise = (s2, r2) reportResult BuildPlanCheckOk {} snap = do $logInfo $ "* Matches " <> renderSnapName snap $logInfo "" reportResult r@BuildPlanCheckPartial {} snap = do $logWarn $ "* Partially matches " <> renderSnapName snap $logWarn $ indent $ T.pack $ show r reportResult r@BuildPlanCheckFail {} snap = do $logWarn $ "* Rejected " <> renderSnapName snap $logWarn $ indent $ T.pack $ show r indent t = T.unlines $ fmap (" " <>) (T.lines t) showItems :: Show a => [a] -> Text showItems items = T.concat (map formatItem items) where formatItem item = T.concat [ " - " , T.pack $ show item , "\n" ] showPackageFlags :: PackageName -> Map FlagName Bool -> Text showPackageFlags pkg fl = if (not $ Map.null fl) then T.concat [ " - " , T.pack $ packageNameString pkg , ": " , T.pack $ intercalate ", " $ map formatFlags (Map.toList fl) , "\n" ] else "" where formatFlags (f, v) = (show f) ++ " = " ++ (show v) showMapPackages :: Map PackageName a -> Text showMapPackages mp = showItems $ Map.keys mp showCompilerErrors :: Map PackageName (Map FlagName Bool) -> DepErrors -> CompilerVersion -> Text showCompilerErrors flags errs compiler = T.concat [ compilerVersionText compiler , " cannot be used for these packages:\n" , showMapPackages $ Map.unions (Map.elems (fmap deNeededBy errs)) , showDepErrors flags errs -- TODO only in debug mode ] showDepErrors :: Map PackageName (Map FlagName Bool) -> DepErrors -> Text showDepErrors flags errs = T.concat [ T.concat $ map formatError (Map.toList errs) , if T.null flagVals then "" else ("Using package flags:\n" <> flagVals) ] where formatError (depName, DepError mversion neededBy) = T.concat [ showDepVersion depName mversion , T.concat (map showRequirement (Map.toList neededBy)) ] showDepVersion depName mversion = T.concat [ T.pack $ packageNameString depName , case mversion of Nothing -> " not found" Just version -> T.concat [ " version " , T.pack $ versionString version , " found" ] , "\n" ] showRequirement (user, range) = T.concat [ " - " , T.pack $ packageNameString user , " requires " , T.pack $ display range , "\n" ] flagVals = T.concat (map showFlags userPkgs) userPkgs = Map.keys $ Map.unions (Map.elems (fmap deNeededBy errs)) showFlags pkg = maybe "" (showPackageFlags pkg) (Map.lookup pkg flags) shadowMiniBuildPlan :: MiniBuildPlan -> Set PackageName -> (MiniBuildPlan, Map PackageName MiniPackageInfo) shadowMiniBuildPlan (MiniBuildPlan cv pkgs0) shadowed = (MiniBuildPlan cv (Map.fromList met), Map.fromList unmet) where pkgs1 = Map.difference pkgs0 $ Map.fromSet (\_ -> ()) shadowed depsMet = flip execState Map.empty $ mapM_ (check Set.empty) (Map.keys pkgs1) check visited name | name `Set.member` visited = error $ "shadowMiniBuildPlan: cycle detected, your MiniBuildPlan is broken: " ++ show (visited, name) | otherwise = do m <- get case Map.lookup name m of Just x -> return x Nothing -> case Map.lookup name pkgs1 of Nothing | name `Set.member` shadowed -> return False -- In this case, we have to assume that we're -- constructing a build plan on a different OS or -- architecture, and therefore different packages -- are being chosen. The common example of this is -- the Win32 package. | otherwise -> return True Just mpi -> do let visited' = Set.insert name visited ress <- mapM (check visited') (Set.toList $ mpiPackageDeps mpi) let res = and ress modify $ \m' -> Map.insert name res m' return res (met, unmet) = partitionEithers $ map toEither $ Map.toList pkgs1 toEither pair@(name, _) = wrapper pair where wrapper = case Map.lookup name depsMet of Just True -> Left Just False -> Right Nothing -> assert False Right -- This works differently for snapshots fetched from URL and those -- fetched from file: -- -- 1) If downloading the snapshot from a URL, assume the fetched data is -- immutable. Hash the URL in order to determine the location of the -- cached download. The file contents of the snapshot determines the -- hash for looking up cached MBP. -- -- 2) If loading the snapshot from a file, load all of the involved -- snapshot files. The hash used to determine the cached MBP is the hash -- of the concatenation of the parent's hash with the snapshot contents. -- -- Why this difference? We want to make it easy to simply edit snapshots -- in the filesystem, but we want caching for remote snapshots. In order -- to avoid reparsing / reloading all the yaml for remote snapshots, we -- need a different hash system. -- TODO: This could probably be more efficient if it first merged the -- custom snapshots, and then applied them to the MBP. It is nice to -- apply directly, because then we have the guarantee that it's -- semantically identical to snapshot extension. If this optimization is -- implemented, note that the direct Monoid for CustomSnapshot is not -- correct. Crucially, if a package is present in the snapshot, its -- flags and ghc-options are not based on settings from prior snapshots. -- TODO: This semantics should be discussed / documented more. -- TODO: allow a hash check in the resolver. This adds safety / -- correctness, allowing you to ensure that you are indeed getting the -- right custom snapshot. -- TODO: Allow custom plan to specify a name. parseCustomMiniBuildPlan :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasHttpManager env, HasConfig env, HasGHCVariant env, MonadBaseControl IO m) => Maybe (Path Abs File) -- ^ Root directory for when url is a filepath -> T.Text -> m (MiniBuildPlan, SnapshotHash) parseCustomMiniBuildPlan mconfigPath0 url0 = do $logDebug $ "Loading " <> url0 <> " build plan" case parseUrl $ T.unpack url0 of Just req -> downloadCustom url0 req Nothing -> case mconfigPath0 of Nothing -> throwM $ FilepathInDownloadedSnapshot url0 Just configPath -> do (getMbp, hash) <- readCustom configPath url0 mbp <- getMbp -- NOTE: We make the choice of only writing a cache -- file for the full MBP, not the intermediate ones. -- This isn't necessarily the best choice if we want -- to share work extended snapshots. I think only -- writing this one is more efficient for common -- cases. binaryPath <- getBinaryPath hash alreadyCached <- doesFileExist binaryPath unless alreadyCached $ taggedEncodeFile binaryPath mbp return (mbp, hash) where downloadCustom url req = do let urlHash = S8.unpack $ trimmedSnapshotHash $ doHash $ encodeUtf8 url hashFP <- parseRelFile $ urlHash ++ ".yaml" customPlanDir <- getCustomPlanDir let cacheFP = customPlanDir $(mkRelDir "yaml") hashFP _ <- download req cacheFP yamlBS <- liftIO $ S.readFile $ toFilePath cacheFP let yamlHash = doHash yamlBS binaryPath <- getBinaryPath yamlHash liftM (, yamlHash) $ taggedDecodeOrLoad binaryPath $ do (cs, mresolver) <- decodeYaml yamlBS parentMbp <- case (csCompilerVersion cs, mresolver) of (Nothing, Nothing) -> throwM (NeitherCompilerOrResolverSpecified url) (Just cv, Nothing) -> return (compilerBuildPlan cv) -- NOTE: ignoring the parent's hash, even though -- there could be one. URL snapshot's hash are -- determined just from their contents. (_, Just resolver) -> liftM fst (loadResolver Nothing resolver) applyCustomSnapshot cs parentMbp readCustom configPath path = do yamlFP <- resolveFile (parent configPath) (T.unpack $ fromMaybe path $ T.stripPrefix "file://" path <|> T.stripPrefix "file:" path) yamlBS <- liftIO $ S.readFile $ toFilePath yamlFP (cs, mresolver) <- decodeYaml yamlBS (getMbp, hash) <- case mresolver of Just (ResolverCustom _ url ) -> case parseUrl $ T.unpack url of Just req -> do let getMbp = do -- Ignore custom hash, under the -- assumption that the URL is sufficient -- for identity. (mbp, _) <- downloadCustom url req return mbp return (getMbp, doHash yamlBS) Nothing -> do (getMbp0, SnapshotHash hash0) <- readCustom yamlFP url let hash = doHash (hash0 <> yamlBS) getMbp = do binaryPath <- getBinaryPath hash -- Idea here is to not waste time -- writing out intermediate cache files, -- but check for them. exists <- doesFileExist binaryPath if exists then do eres <- decodeFileOrFailDeep binaryPath case eres of Right (Just mbp) -> return mbp -- Invalid format cache file, remove. _ -> do removeFile binaryPath getMbp0 else getMbp0 return (getMbp, hash) Just resolver -> do -- NOTE: in the cases where we don't have a hash, the -- normal resolver name is enough. Since this name is -- part of the yaml file, it ends up in our hash. let hash = doHash yamlBS getMbp = do (mbp, resolver') <- loadResolver (Just configPath) resolver let mhash = customResolverHash resolver' assert (isNothing mhash) (return mbp) return (getMbp, hash) Nothing -> do case csCompilerVersion cs of Nothing -> throwM (NeitherCompilerOrResolverSpecified path) Just cv -> do let hash = doHash yamlBS getMbp = return (compilerBuildPlan cv) return (getMbp, hash) return (applyCustomSnapshot cs =<< getMbp, hash) getBinaryPath hash = do binaryFilename <- parseRelFile $ S8.unpack (trimmedSnapshotHash hash) ++ ".bin" customPlanDir <- getCustomPlanDir return $ customPlanDir $(mkRelDir "bin") binaryFilename decodeYaml yamlBS = do WithJSONWarnings res warnings <- either (throwM . ParseCustomSnapshotException url0) return $ decodeEither' yamlBS logJSONWarnings (T.unpack url0) warnings return res compilerBuildPlan cv = MiniBuildPlan { mbpCompilerVersion = cv , mbpPackages = mempty } getCustomPlanDir = do root <- asks $ configStackRoot . getConfig return $ root $(mkRelDir "custom-plan") doHash = SnapshotHash . B64URL.encode . SHA256.hash applyCustomSnapshot :: (MonadIO m, MonadLogger m, MonadReader env m, HasHttpManager env, HasConfig env, MonadBaseControl IO m, MonadMask m) => CustomSnapshot -> MiniBuildPlan -> m MiniBuildPlan applyCustomSnapshot cs mbp0 = do let CustomSnapshot mcompilerVersion packages dropPackages (PackageFlags flags) ghcOptions = cs addFlagsAndOpts :: PackageIdentifier -> (PackageName, (Version, Map FlagName Bool, [Text], Maybe GitSHA1)) addFlagsAndOpts (PackageIdentifier name ver) = ( name , ( ver , Map.findWithDefault Map.empty name flags -- NOTE: similar to 'allGhcOptions' in Stack.Types.Build , ghcOptionsFor name ghcOptions -- we add a Nothing since we don't yet collect Git SHAs for custom snapshots , Nothing ) ) packageMap = Map.fromList $ map addFlagsAndOpts $ Set.toList packages cv = fromMaybe (mbpCompilerVersion mbp0) mcompilerVersion packages0 = mbpPackages mbp0 `Map.difference` (Map.fromSet (\_ -> ()) dropPackages) mbp1 <- toMiniBuildPlan cv mempty packageMap return $ MiniBuildPlan { mbpCompilerVersion = cv , mbpPackages = Map.union (mbpPackages mbp1) packages0 } stack-1.1.2/src/Stack/Clean.hs0000644000000000000000000000546612706265473014247 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -- | Clean a project. module Stack.Clean (clean ,CleanOpts(..) ,StackCleanException(..) ) where import Control.Exception (Exception) import Control.Monad.Catch (MonadCatch, MonadThrow, throwM) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Logger (MonadLogger) import Control.Monad.Reader (MonadReader, asks) import Data.Foldable (forM_) import Data.List ((\\),intercalate) import qualified Data.Map.Strict as Map import Data.Maybe (mapMaybe) import Data.Typeable (Typeable) import Path (Path, Abs, Dir) import Path.IO (ignoringAbsence, removeDirRecur) import Stack.Build.Source (getLocalPackageViews) import Stack.Build.Target (LocalPackageView(..)) import Stack.Constants (distDirFromDir, workDirFromDir) import Stack.Types -- | Deletes build artifacts in the current project. -- -- Throws 'StackCleanException'. clean :: (MonadCatch m, MonadIO m, MonadReader env m, HasEnvConfig env, MonadLogger m) => CleanOpts -> m () clean cleanOpts = do dirs <- dirsToDelete cleanOpts forM_ dirs (ignoringAbsence . removeDirRecur) dirsToDelete :: (MonadThrow m, MonadIO m, MonadReader env m, HasEnvConfig env, MonadLogger m) => CleanOpts -> m [Path Abs Dir] dirsToDelete cleanOpts = do localPkgDirs <- asks (Map.keys . envConfigPackages . getEnvConfig) case cleanOpts of CleanShallow [] -> do mapM distDirFromDir localPkgDirs CleanShallow targets -> do localPkgViews <- getLocalPackageViews let localPkgNames = Map.keys localPkgViews getPkgDir pkgName = fmap (lpvRoot . fst) (Map.lookup pkgName localPkgViews) case targets \\ localPkgNames of [] -> mapM distDirFromDir (mapMaybe getPkgDir targets) xs -> throwM (NonLocalPackages xs) CleanFull -> do pkgWorkDirs <- mapM workDirFromDir localPkgDirs projectWorkDir <- getProjectWorkDir return (projectWorkDir : pkgWorkDirs) -- | Options for @stack clean@. data CleanOpts = CleanShallow [PackageName] -- ^ Delete the "dist directories" as defined in 'Stack.Constants.distRelativeDir' -- for the given local packages. If no packages are given, all project packages -- should be cleaned. | CleanFull -- ^ Delete all work directories in the project. -- | Exceptions during cleanup. newtype StackCleanException = NonLocalPackages [PackageName] deriving (Typeable) instance Show StackCleanException where show (NonLocalPackages pkgs) = "The following packages are not part of this project: " ++ intercalate ", " (map show pkgs) instance Exception StackCleanException stack-1.1.2/src/Stack/Config.hs0000644000000000000000000011413412717707440014420 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TupleSections #-} -- | The general Stack configuration that starts everything off. This should -- be smart to falback if there is no stack.yaml, instead relying on -- whatever files are available. -- -- If there is no stack.yaml, and there is a cabal.config, we -- read in those constraints, and if there's a cabal.sandbox.config, -- we read any constraints from there and also find the package -- database from there, etc. And if there's nothing, we should -- probably default to behaving like cabal, possibly with spitting out -- a warning that "you should run `stk init` to make things better". module Stack.Config (MiniConfig ,loadConfig ,loadConfigMaybeProject ,loadMiniConfig ,packagesParser ,resolvePackageEntry ,getImplicitGlobalProjectDir ,getIsGMP4 ,getSnapshots ,makeConcreteResolver ,checkOwnership ,getInContainer ) where import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Zip as Zip import qualified Codec.Compression.GZip as GZip import Control.Applicative import Control.Arrow ((***)) import Control.Exception (assert) import Control.Monad (liftM, unless, when, filterM) import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask, catchAll, throwM, catch) import Control.Monad.Extra (firstJustM) import Control.Monad.IO.Class import Control.Monad.Logger hiding (Loc) import Control.Monad.Reader (MonadReader, ask, asks, runReaderT) import Control.Monad.Trans.Control (MonadBaseControl) import qualified Crypto.Hash.SHA256 as SHA256 import Data.Aeson.Extended import qualified Data.ByteString as S import qualified Data.ByteString.Base64.URL as B64URL import qualified Data.ByteString.Lazy as L import Data.Foldable (forM_) import qualified Data.IntMap as IntMap import Data.IORef (newIORef) import qualified Data.Map as Map import Data.Maybe import Data.Monoid.Extra import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8, decodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Yaml as Yaml import Distribution.System (OS (..), Platform (..), buildPlatform) import qualified Distribution.Text import Distribution.Version (simplifyVersionRange) import GHC.Conc (getNumProcessors) import Network.HTTP.Client.Conduit (HasHttpManager, getHttpManager, Manager, parseUrl) import Network.HTTP.Download (download, downloadJSON) import Options.Applicative (Parser, strOption, long, help) import Path import Path.Extra (toFilePathNoTrailingSep) import Path.Find (findInParents) import Path.IO import qualified Paths_stack as Meta import Safe (headMay) import Stack.BuildPlan import Stack.Config.Build import Stack.Config.Urls import Stack.Config.Docker import Stack.Config.Nix import Stack.Constants import qualified Stack.Image as Image import Stack.Types import Stack.Types.Internal import System.Environment import System.IO import System.PosixCompat.Files (fileOwner, getFileStatus) import System.PosixCompat.User (getEffectiveUserID) import System.Process.Read -- | If deprecated path exists, use it and print a warning. -- Otherwise, return the new path. tryDeprecatedPath :: (MonadIO m, MonadLogger m) => Maybe T.Text -- ^ Description of file for warning (if Nothing, no deprecation warning is displayed) -> (Path Abs a -> m Bool) -- ^ Test for existence -> Path Abs a -- ^ New path -> Path Abs a -- ^ Deprecated path -> m (Path Abs a, Bool) -- ^ (Path to use, whether it already exists) tryDeprecatedPath mWarningDesc exists new old = do newExists <- exists new if newExists then return (new, True) else do oldExists <- exists old if oldExists then do case mWarningDesc of Nothing -> return () Just desc -> $logWarn $ T.concat [ "Warning: Location of ", desc, " at '" , T.pack (toFilePath old) , "' is deprecated; rename it to '" , T.pack (toFilePath new) , "' instead" ] return (old, True) else return (new, False) -- | Get the location of the implicit global project directory. -- If the directory already exists at the deprecated location, its location is returned. -- Otherwise, the new location is returned. getImplicitGlobalProjectDir :: (MonadIO m, MonadLogger m) => Config -> m (Path Abs Dir) getImplicitGlobalProjectDir config = --TEST no warning printed liftM fst $ tryDeprecatedPath Nothing doesDirExist (implicitGlobalProjectDir stackRoot) (implicitGlobalProjectDirDeprecated stackRoot) where stackRoot = configStackRoot config -- | Download the 'Snapshots' value from stackage.org. getSnapshots :: (MonadThrow m, MonadMask m, MonadIO m, MonadReader env m, HasHttpManager env, HasConfig env, MonadLogger m) => m Snapshots getSnapshots = do latestUrlText <- askLatestSnapshotUrl latestUrl <- parseUrl (T.unpack latestUrlText) $logDebug $ "Downloading snapshot versions file from " <> latestUrlText result <- downloadJSON latestUrl $logDebug $ "Done downloading and parsing snapshot versions file" return result -- | Turn an 'AbstractResolver' into a 'Resolver'. makeConcreteResolver :: (MonadIO m, MonadReader env m, HasConfig env, MonadThrow m, MonadMask m, HasHttpManager env, MonadLogger m) => AbstractResolver -> m Resolver makeConcreteResolver (ARResolver r) = return r makeConcreteResolver ar = do snapshots <- getSnapshots r <- case ar of ARResolver r -> assert False $ return r ARGlobal -> do config <- asks getConfig implicitGlobalDir <- getImplicitGlobalProjectDir config let fp = implicitGlobalDir stackDotYaml WithJSONWarnings (ProjectAndConfigMonoid project _) _warnings <- liftIO (Yaml.decodeFileEither $ toFilePath fp) >>= either throwM return return $ projectResolver project ARLatestNightly -> return $ ResolverSnapshot $ Nightly $ snapshotsNightly snapshots ARLatestLTSMajor x -> case IntMap.lookup x $ snapshotsLts snapshots of Nothing -> error $ "No LTS release found with major version " ++ show x Just y -> return $ ResolverSnapshot $ LTS x y ARLatestLTS | IntMap.null $ snapshotsLts snapshots -> error "No LTS releases found" | otherwise -> let (x, y) = IntMap.findMax $ snapshotsLts snapshots in return $ ResolverSnapshot $ LTS x y $logInfo $ "Selected resolver: " <> resolverName r return r -- | Get the latest snapshot resolver available. getLatestResolver :: (MonadIO m, MonadMask m, MonadReader env m, HasConfig env, HasHttpManager env, MonadLogger m) => m Resolver getLatestResolver = do snapshots <- getSnapshots let mlts = do (x,y) <- listToMaybe (reverse (IntMap.toList (snapshotsLts snapshots))) return (LTS x y) snap = fromMaybe (Nightly (snapshotsNightly snapshots)) mlts return (ResolverSnapshot snap) -- Interprets ConfigMonoid options. configFromConfigMonoid :: (MonadLogger m, MonadIO m, MonadCatch m) => Path Abs Dir -- ^ stack root, e.g. ~/.stack -> Path Abs File -- ^ user config file path, e.g. ~/.stack/config.yaml -> Maybe AbstractResolver -> Maybe (Project, Path Abs File) -> ConfigMonoid -> m Config configFromConfigMonoid configStackRoot configUserConfigPath mresolver mproject ConfigMonoid{..} = do configWorkDir <- parseRelDir (fromFirst ".stack-work" configMonoidWorkDir) -- This code is to handle the deprecation of latest-snapshot-url configUrls <- case (getFirst configMonoidLatestSnapshotUrl, getFirst (urlsMonoidLatestSnapshot configMonoidUrls)) of (Just url, Nothing) -> do $logWarn "The latest-snapshot-url field is deprecated in favor of 'urls' configuration" return (urlsFromMonoid configMonoidUrls) { urlsLatestSnapshot = url } _ -> return (urlsFromMonoid configMonoidUrls) let configConnectionCount = fromFirst 8 configMonoidConnectionCount configHideTHLoading = fromFirst True configMonoidHideTHLoading configPackageIndices = fromFirst [PackageIndex { indexName = IndexName "Hackage" , indexLocation = ILGitHttp "https://github.com/commercialhaskell/all-cabal-hashes.git" "https://s3.amazonaws.com/hackage.fpcomplete.com/00-index.tar.gz" , indexDownloadPrefix = "https://s3.amazonaws.com/hackage.fpcomplete.com/package/" , indexGpgVerify = False , indexRequireHashes = False }] configMonoidPackageIndices configGHCVariant0 = getFirst configMonoidGHCVariant configSystemGHC = fromFirst (isNothing configGHCVariant0) configMonoidSystemGHC configInstallGHC = fromFirst False configMonoidInstallGHC configSkipGHCCheck = fromFirst False configMonoidSkipGHCCheck configSkipMsys = fromFirst False configMonoidSkipMsys configExtraIncludeDirs = configMonoidExtraIncludeDirs configExtraLibDirs = configMonoidExtraLibDirs -- Only place in the codebase where platform is hard-coded. In theory -- in the future, allow it to be configured. (Platform defArch defOS) = buildPlatform arch = fromMaybe defArch $ (getFirst configMonoidArch) >>= Distribution.Text.simpleParse os = fromMaybe defOS $ (getFirst configMonoidOS) >>= Distribution.Text.simpleParse configPlatform = Platform arch os configRequireStackVersion = simplifyVersionRange (getIntersectingVersionRange configMonoidRequireStackVersion) configImage = Image.imgOptsFromMonoid configMonoidImageOpts configCompilerCheck = fromFirst MatchMinor configMonoidCompilerCheck configPlatformVariant <- liftIO $ maybe PlatformVariantNone PlatformVariant <$> lookupEnv platformVariantEnvVar let configBuild = buildOptsFromMonoid configMonoidBuildOpts configDocker <- dockerOptsFromMonoid (fmap fst mproject) configStackRoot mresolver configMonoidDockerOpts configNix <- nixOptsFromMonoid configMonoidNixOpts os rawEnv <- liftIO getEnvironment pathsEnv <- augmentPathMap (map toFilePath configMonoidExtraPath) (Map.fromList (map (T.pack *** T.pack) rawEnv)) origEnv <- mkEnvOverride configPlatform pathsEnv let configEnvOverride _ = return origEnv platformOnlyDir <- runReaderT platformOnlyRelDir (configPlatform,configPlatformVariant) configLocalProgramsBase <- case configPlatform of Platform _ Windows -> do progsDir <- getWindowsProgsDir configStackRoot origEnv return $ progsDir $(mkRelDir stackProgName) _ -> return $ configStackRoot $(mkRelDir "programs") let configLocalPrograms = configLocalProgramsBase platformOnlyDir configLocalBin <- case getFirst configMonoidLocalBinPath of Nothing -> do localDir <- getAppUserDataDir "local" return $ localDir $(mkRelDir "bin") Just userPath -> (case mproject of -- Not in a project Nothing -> resolveDir' userPath -- Resolves to the project dir and appends the user path if it is relative Just (_, configYaml) -> resolveDir (parent configYaml) userPath) -- TODO: Either catch specific exceptions or add a -- parseRelAsAbsDirMaybe utility and use it along with -- resolveDirMaybe. `catchAll` const (throwM (NoSuchDirectory userPath)) configJobs <- case getFirst configMonoidJobs of Nothing -> liftIO getNumProcessors Just i -> return i let configConcurrentTests = fromFirst True configMonoidConcurrentTests let configTemplateParams = configMonoidTemplateParameters configScmInit = getFirst configMonoidScmInit configGhcOptions = configMonoidGhcOptions configSetupInfoLocations = configMonoidSetupInfoLocations configPvpBounds = fromFirst PvpBoundsNone configMonoidPvpBounds configModifyCodePage = fromFirst True configMonoidModifyCodePage configExplicitSetupDeps = configMonoidExplicitSetupDeps configRebuildGhcOptions = fromFirst False configMonoidRebuildGhcOptions configApplyGhcOptions = fromFirst AGOLocals configMonoidApplyGhcOptions configAllowNewer = fromFirst False configMonoidAllowNewer configDefaultTemplate = getFirst configMonoidDefaultTemplate configAllowDifferentUser <- case getFirst configMonoidAllowDifferentUser of Just True -> return True _ -> getInContainer configPackageCaches <- liftIO $ newIORef Nothing let configMaybeProject = mproject return Config {..} -- | Get the default 'GHCVariant'. On older Linux systems with libgmp4, returns 'GHCGMP4'. getDefaultGHCVariant :: (MonadIO m, MonadBaseControl IO m, MonadCatch m, MonadLogger m) => EnvOverride -> Platform -> m GHCVariant getDefaultGHCVariant menv (Platform _ Linux) = do $logDebug "Checking whether stack was built with libgmp4" isGMP4 <- getIsGMP4 menv if isGMP4 then $logDebug "Stack was built with libgmp4, so the default ghc-variant will be gmp4" else $logDebug "Stack was not built with libgmp4" return (if isGMP4 then GHCGMP4 else GHCStandard) getDefaultGHCVariant _ _ = return GHCStandard -- Determine whether 'stack' is linked with libgmp4 (libgmp.so.3) getIsGMP4 :: (MonadIO m, MonadBaseControl IO m, MonadCatch m, MonadLogger m) => EnvOverride -> m Bool getIsGMP4 menv = do executablePath <- liftIO getExecutablePath elddOut <- tryProcessStdout Nothing menv "ldd" [executablePath] return $ case elddOut of Left _ -> False Right lddOut -> hasLineWithFirstWord "libgmp.so.3" lddOut where hasLineWithFirstWord w = elem (Just w) . map (headMay . T.words) . T.lines . decodeUtf8With lenientDecode -- | Get the directory on Windows where we should install extra programs. For -- more information, see discussion at: -- https://github.com/fpco/minghc/issues/43#issuecomment-99737383 getWindowsProgsDir :: MonadThrow m => Path Abs Dir -> EnvOverride -> m (Path Abs Dir) getWindowsProgsDir stackRoot m = case Map.lookup "LOCALAPPDATA" $ unEnvOverride m of Just t -> do lad <- parseAbsDir $ T.unpack t return $ lad $(mkRelDir "Programs") Nothing -> return $ stackRoot $(mkRelDir "Programs") -- | An environment with a subset of BuildConfig used for setup. data MiniConfig = MiniConfig Manager GHCVariant Config instance HasConfig MiniConfig where getConfig (MiniConfig _ _ c) = c instance HasStackRoot MiniConfig instance HasHttpManager MiniConfig where getHttpManager (MiniConfig man _ _) = man instance HasPlatform MiniConfig instance HasGHCVariant MiniConfig where getGHCVariant (MiniConfig _ v _) = v -- | Load the 'MiniConfig'. loadMiniConfig :: (MonadIO m, MonadBaseControl IO m, MonadCatch m, MonadLogger m) => Manager -> Config -> m MiniConfig loadMiniConfig manager config = do menv <- liftIO $ configEnvOverride config minimalEnvSettings ghcVariant <- case configGHCVariant0 config of Just ghcVariant -> return ghcVariant Nothing -> getDefaultGHCVariant menv (configPlatform config) return (MiniConfig manager ghcVariant config) -- Load the configuration, using environment variables, and defaults as -- necessary. loadConfigMaybeProject :: (MonadLogger m,MonadIO m,MonadMask m,MonadBaseControl IO m,MonadReader env m,HasHttpManager env,HasTerminal env) => ConfigMonoid -- ^ Config monoid from parsed command-line arguments -> Maybe AbstractResolver -- ^ Override resolver -> Maybe (Project, Path Abs File, ConfigMonoid) -- ^ Project config to use, if any -> m (LoadConfig m) loadConfigMaybeProject configArgs mresolver mproject = do (stackRoot, userOwnsStackRoot) <- determineStackRootAndOwnership configArgs userConfigPath <- getDefaultUserConfigPath stackRoot extraConfigs0 <- getExtraConfigs userConfigPath >>= mapM loadConfigYaml let extraConfigs = -- non-project config files' existence of a docker section should never default docker -- to enabled, so make it look like they didn't exist map (\c -> c {configMonoidDockerOpts = (configMonoidDockerOpts c) {dockerMonoidDefaultEnable = Any False}}) extraConfigs0 let mproject' = (\(project, stackYaml, _) -> (project, stackYaml)) <$> mproject config <- configFromConfigMonoid stackRoot userConfigPath mresolver mproject' $ mconcat $ case mproject of Nothing -> configArgs : extraConfigs Just (_, _, projectConfig) -> configArgs : projectConfig : extraConfigs unless (fromCabalVersion Meta.version `withinRange` configRequireStackVersion config) (throwM (BadStackVersionException (configRequireStackVersion config))) let mprojectRoot = fmap (\(_, fp, _) -> parent fp) mproject unless (configAllowDifferentUser config) $ do unless userOwnsStackRoot $ throwM (UserDoesn'tOwnDirectory stackRoot) forM_ mprojectRoot $ \dir -> checkOwnership (dir configWorkDir config) return LoadConfig { lcConfig = config , lcLoadBuildConfig = loadBuildConfig mproject config mresolver , lcProjectRoot = mprojectRoot } -- | Load the configuration, using current directory, environment variables, -- and defaults as necessary. The passed @Maybe (Path Abs File)@ is an -- override for the location of the project's stack.yaml. loadConfig :: (MonadLogger m,MonadIO m,MonadMask m,MonadBaseControl IO m,MonadReader env m,HasHttpManager env,HasTerminal env) => ConfigMonoid -- ^ Config monoid from parsed command-line arguments -> Maybe AbstractResolver -- ^ Override resolver -> Maybe (Path Abs File) -- ^ Override stack.yaml -> m (LoadConfig m) loadConfig configArgs mresolver mstackYaml = loadProjectConfig mstackYaml >>= loadConfigMaybeProject configArgs mresolver -- | Load the build configuration, adds build-specific values to config loaded by @loadConfig@. -- values. loadBuildConfig :: (MonadLogger m, MonadIO m, MonadMask m, MonadReader env m, HasHttpManager env, MonadBaseControl IO m, HasTerminal env) => Maybe (Project, Path Abs File, ConfigMonoid) -> Config -> Maybe AbstractResolver -- override resolver -> Maybe CompilerVersion -- override compiler -> m BuildConfig loadBuildConfig mproject config mresolver mcompiler = do env <- ask manager <- getHttpManager <$> ask miniConfig <- loadMiniConfig manager config (project', stackYamlFP) <- case mproject of Just (project, fp, _) -> do forM_ (projectUserMsg project) ($logWarn . T.pack) return (project, fp) Nothing -> do $logInfo "Run from outside a project, using implicit global project config" destDir <- getImplicitGlobalProjectDir config let dest :: Path Abs File dest = destDir stackDotYaml dest' :: FilePath dest' = toFilePath dest ensureDir destDir exists <- doesFileExist dest if exists then do ProjectAndConfigMonoid project _ <- loadConfigYaml dest when (getTerminal env) $ case mresolver of Nothing -> $logInfo ("Using resolver: " <> resolverName (projectResolver project) <> " from implicit global project's config file: " <> T.pack dest') Just aresolver -> do let name = case aresolver of ARResolver resolver -> resolverName resolver ARLatestNightly -> "nightly" ARLatestLTS -> "lts" ARLatestLTSMajor x -> T.pack $ "lts-" ++ show x ARGlobal -> "global" $logInfo ("Using resolver: " <> name <> " specified on command line") return (project, dest) else do r <- runReaderT getLatestResolver miniConfig $logInfo ("Using latest snapshot resolver: " <> resolverName r) $logInfo ("Writing implicit global project config file to: " <> T.pack dest') $logInfo "Note: You can change the snapshot via the resolver field there." let p = Project { projectUserMsg = Nothing , projectPackages = mempty , projectExtraDeps = mempty , projectFlags = mempty , projectResolver = r , projectCompiler = Nothing , projectExtraPackageDBs = [] } liftIO $ do S.writeFile dest' $ S.concat [ "# This is the implicit global project's config file, which is only used when\n" , "# 'stack' is run outside of a real project. Settings here do _not_ act as\n" , "# defaults for all projects. To change stack's default settings, edit\n" , "# '", encodeUtf8 (T.pack $ toFilePath $ configUserConfigPath config), "' instead.\n" , "#\n" , "# For more information about stack's configuration, see\n" , "# http://docs.haskellstack.org/en/stable/yaml_configuration/\n" , "#\n" , Yaml.encode p] S.writeFile (toFilePath $ parent dest $(mkRelFile "README.txt")) $ S.concat [ "This is the implicit global project, which is used only when 'stack' is run\n" , "outside of a real project.\n" ] return (p, dest) resolver <- case mresolver of Nothing -> return $ projectResolver project' Just aresolver -> runReaderT (makeConcreteResolver aresolver) miniConfig let project = project' { projectResolver = resolver , projectCompiler = mcompiler <|> projectCompiler project' } (mbp0, loadedResolver) <- flip runReaderT miniConfig $ loadResolver (Just stackYamlFP) (projectResolver project) let mbp = case projectCompiler project of Just compiler -> mbp0 { mbpCompilerVersion = compiler } Nothing -> mbp0 extraPackageDBs <- mapM resolveDir' (projectExtraPackageDBs project) return BuildConfig { bcConfig = config , bcResolver = loadedResolver , bcWantedMiniBuildPlan = mbp , bcPackageEntries = projectPackages project , bcExtraDeps = projectExtraDeps project , bcExtraPackageDBs = extraPackageDBs , bcStackYaml = stackYamlFP , bcFlags = projectFlags project , bcImplicitGlobal = isNothing mproject , bcGHCVariant = getGHCVariant miniConfig } -- | Resolve a PackageEntry into a list of paths, downloading and cloning as -- necessary. resolvePackageEntry :: (MonadIO m, MonadReader env m, HasHttpManager env, MonadLogger m, MonadCatch m ,MonadBaseControl IO m, HasConfig env) => EnvOverride -> Path Abs Dir -- ^ project root -> PackageEntry -> m [(Path Abs Dir, TreatLikeExtraDep)] resolvePackageEntry menv projRoot pe = do entryRoot <- resolvePackageLocation menv projRoot (peLocation pe) paths <- case peSubdirs pe of [] -> return [entryRoot] subs -> mapM (resolveDir entryRoot) subs return $ map (, peExtraDep pe) paths -- | Resolve a PackageLocation into a path, downloading and cloning as -- necessary. resolvePackageLocation :: (MonadIO m, MonadReader env m, HasHttpManager env, MonadLogger m, MonadCatch m ,MonadBaseControl IO m, HasConfig env) => EnvOverride -> Path Abs Dir -- ^ project root -> PackageLocation -> m (Path Abs Dir) resolvePackageLocation _ projRoot (PLFilePath fp) = resolveDir projRoot fp resolvePackageLocation menv projRoot (PLRemote url remotePackageType) = do -- NOTE: we used to include the commit in the package location. This -- allowed us to quickly check if the dir exists, and use it if it -- does. Now, we instead always do a reset. This is still pretty -- fast - a no-op git reset is around 0.01 seconds on my machine. workDir <- getWorkDir let nameBeforeHashing = case remotePackageType of RPTHttp{} -> url RPTGit{} -> url RPTHg{} -> T.unwords [url, "hg"] -- TODO: dedupe with code for snapshot hash? name = T.unpack $ decodeUtf8 $ S.take 12 $ B64URL.encode $ SHA256.hash $ encodeUtf8 nameBeforeHashing root = projRoot workDir $(mkRelDir "downloaded") fileExtension = case remotePackageType of RPTHttp -> ".http-archive" _ -> ".unused" fileRel <- parseRelFile $ name ++ fileExtension dirRel <- parseRelDir name dirRelTmp <- parseRelDir $ name ++ ".tmp" let file = root fileRel dir = root dirRel exists <- doesDirExist dir let cloneAndExtract commandName cloneArgs resetCommand commit = do ensureDir (parent dir) (if exists then doReset True else doClone >> doReset True) `catch` \case ReadProcessException{} -> do ignoringAbsence (removeDirRecur dir) doClone doReset False _ -> return () return dir where doClone = readProcessNull (Just (parent dir)) menv commandName ("clone" : cloneArgs ++ [ T.unpack url , toFilePathNoTrailingSep dir ]) doReset firstTry = readProcessNull (Just dir) menv commandName (resetCommand ++ [T.unpack commit, "--"]) `catch` \case ex@ReadProcessException{} -> do unless firstTry $ $logInfo $ "Please ensure that commit " <> commit <> " exists within " <> url throwM ex ex -> throwM ex case remotePackageType of RPTHttp -> do unless exists $ do let dirTmp = root dirRelTmp ignoringAbsence (removeDirRecur dirTmp) let fp = toFilePath file req <- parseUrl $ T.unpack url _ <- download req file let tryTar = do $logDebug $ "Trying to untar " <> T.pack fp liftIO $ withBinaryFile fp ReadMode $ \h -> do lbs <- L.hGetContents h let entries = Tar.read $ GZip.decompress lbs Tar.unpack (toFilePath dirTmp) entries tryZip = do $logDebug $ "Trying to unzip " <> T.pack fp archive <- fmap Zip.toArchive $ liftIO $ L.readFile fp liftIO $ Zip.extractFilesFromArchive [Zip.OptDestination (toFilePath dirTmp)] archive err = throwM $ UnableToExtractArchive url file catchAllLog goodpath handler = catchAll goodpath $ \e -> do $logDebug $ "Got exception: " <> T.pack (show e) handler tryTar `catchAllLog` tryZip `catchAllLog` err renameDir dirTmp dir x <- listDir dir case x of ([dir'], []) -> return dir' (dirs, files) -> do ignoringAbsence (removeFile file) ignoringAbsence (removeDirRecur dir) throwM $ UnexpectedArchiveContents dirs files RPTGit commit -> cloneAndExtract "git" ["--recursive"] ["reset", "--hard"] commit RPTHg commit -> cloneAndExtract "hg" [] ["update", "-C"] commit -- | Get the stack root, e.g. @~/.stack@, and determine whether the user owns it. -- -- On Windows, the second value is always 'True'. determineStackRootAndOwnership :: (MonadIO m, MonadCatch m) => ConfigMonoid -- ^ Parsed command-line arguments -> m (Path Abs Dir, Bool) determineStackRootAndOwnership clArgs = do stackRoot <- do case getFirst (configMonoidStackRoot clArgs) of Just x -> return x Nothing -> do mstackRoot <- liftIO $ lookupEnv stackRootEnvVar case mstackRoot of Nothing -> getAppUserDataDir stackProgName Just x -> parseAbsDir x (existingStackRootOrParentDir, userOwnsIt) <- do mdirAndOwnership <- findInParents getDirAndOwnership stackRoot case mdirAndOwnership of Just x -> return x Nothing -> throwM (BadStackRoot stackRoot) when (existingStackRootOrParentDir /= stackRoot) $ if userOwnsIt then liftIO $ ensureDir stackRoot else throwM $ Won'tCreateStackRootInDirectoryOwnedByDifferentUser stackRoot existingStackRootOrParentDir stackRoot' <- canonicalizePath stackRoot return (stackRoot', userOwnsIt) -- | @'checkOwnership' dir@ throws 'UserDoesn'tOwnDirectory' if @dir@ -- isn't owned by the current user. -- -- If @dir@ doesn't exist, its parent directory is checked instead. -- If the parent directory doesn't exist either, @'NoSuchDirectory' ('parent' dir)@ -- is thrown. checkOwnership :: (MonadIO m, MonadCatch m) => Path Abs Dir -> m () checkOwnership dir = do mdirAndOwnership <- firstJustM getDirAndOwnership [dir, parent dir] case mdirAndOwnership of Just (_, True) -> return () Just (dir', False) -> throwM (UserDoesn'tOwnDirectory dir') Nothing -> (throwM . NoSuchDirectory) $ (toFilePathNoTrailingSep . parent) dir -- | @'getDirAndOwnership' dir@ returns @'Just' (dir, 'True')@ when @dir@ -- exists and the current user owns it in the sense of 'isOwnedByUser'. getDirAndOwnership :: (MonadIO m, MonadCatch m) => Path Abs Dir -> m (Maybe (Path Abs Dir, Bool)) getDirAndOwnership dir = forgivingAbsence $ do ownership <- isOwnedByUser dir return (dir, ownership) -- | Check whether the current user (determined with 'getEffectiveUserId') is -- the owner for the given path. -- -- Will always return 'True' on Windows. isOwnedByUser :: MonadIO m => Path Abs t -> m Bool isOwnedByUser path = liftIO $ do if osIsWindows then return True else do fileStatus <- getFileStatus (toFilePath path) user <- getEffectiveUserID return (user == fileOwner fileStatus) where #ifdef WINDOWS osIsWindows = True #else osIsWindows = False #endif -- | 'True' if we are currently running inside a Docker container. getInContainer :: (MonadIO m) => m Bool getInContainer = liftIO (isJust <$> lookupEnv inContainerEnvVar) -- | Determine the extra config file locations which exist. -- -- Returns most local first getExtraConfigs :: (MonadIO m, MonadLogger m) => Path Abs File -- ^ use config path -> m [Path Abs File] getExtraConfigs userConfigPath = do defaultStackGlobalConfigPath <- getDefaultGlobalConfigPath liftIO $ do env <- getEnvironment mstackConfig <- maybe (return Nothing) (fmap Just . parseAbsFile) $ lookup "STACK_CONFIG" env mstackGlobalConfig <- maybe (return Nothing) (fmap Just . parseAbsFile) $ lookup "STACK_GLOBAL_CONFIG" env filterM doesFileExist $ fromMaybe userConfigPath mstackConfig : maybe [] return (mstackGlobalConfig <|> defaultStackGlobalConfigPath) -- | Load and parse YAML from the given conig file. Throws -- 'ParseConfigFileException' when there's a decoding error. loadConfigYaml :: (FromJSON (WithJSONWarnings a), MonadIO m, MonadLogger m) => Path Abs File -> m a loadConfigYaml path = do eres <- loadYaml path case eres of Left err -> liftIO $ throwM (ParseConfigFileException path err) Right res -> return res -- | Load and parse YAML from the given file. loadYaml :: (FromJSON (WithJSONWarnings a), MonadIO m, MonadLogger m) => Path Abs File -> m (Either Yaml.ParseException a) loadYaml path = do eres <- liftIO $ Yaml.decodeFileEither (toFilePath path) case eres of Left err -> return (Left err) Right (WithJSONWarnings res warnings) -> do logJSONWarnings (toFilePath path) warnings return (Right res) -- | Get the location of the project config file, if it exists. getProjectConfig :: (MonadIO m, MonadThrow m, MonadLogger m) => Maybe (Path Abs File) -- ^ Override stack.yaml -> m (Maybe (Path Abs File)) getProjectConfig (Just stackYaml) = return $ Just stackYaml getProjectConfig Nothing = do env <- liftIO getEnvironment case lookup "STACK_YAML" env of Just fp -> do $logInfo "Getting project config file from STACK_YAML environment" liftM Just $ resolveFile' fp Nothing -> do currDir <- getCurrentDir findInParents getStackDotYaml currDir where getStackDotYaml dir = do let fp = dir stackDotYaml fp' = toFilePath fp $logDebug $ "Checking for project config at: " <> T.pack fp' exists <- doesFileExist fp if exists then return $ Just fp else return Nothing -- | Find the project config file location, respecting environment variables -- and otherwise traversing parents. If no config is found, we supply a default -- based on current directory. loadProjectConfig :: (MonadIO m, MonadThrow m, MonadLogger m) => Maybe (Path Abs File) -- ^ Override stack.yaml -> m (Maybe (Project, Path Abs File, ConfigMonoid)) loadProjectConfig mstackYaml = do mfp <- getProjectConfig mstackYaml case mfp of Just fp -> do currDir <- getCurrentDir $logDebug $ "Loading project config file " <> T.pack (maybe (toFilePath fp) toFilePath (stripDir currDir fp)) load fp Nothing -> do $logDebug $ "No project config file found, using defaults." return Nothing where load fp = do ProjectAndConfigMonoid project config <- loadConfigYaml fp return $ Just (project, fp, config) -- | Get the location of the default stack configuration file. -- If a file already exists at the deprecated location, its location is returned. -- Otherwise, the new location is returned. getDefaultGlobalConfigPath :: (MonadIO m, MonadLogger m) => m (Maybe (Path Abs File)) getDefaultGlobalConfigPath = case (defaultGlobalConfigPath, defaultGlobalConfigPathDeprecated) of (Just new,Just old) -> liftM (Just . fst ) $ tryDeprecatedPath (Just "non-project global configuration file") doesFileExist new old (Just new,Nothing) -> return (Just new) _ -> return Nothing -- | Get the location of the default user configuration file. -- If a file already exists at the deprecated location, its location is returned. -- Otherwise, the new location is returned. getDefaultUserConfigPath :: (MonadIO m, MonadLogger m) => Path Abs Dir -> m (Path Abs File) getDefaultUserConfigPath stackRoot = do (path, exists) <- tryDeprecatedPath (Just "non-project configuration file") doesFileExist (defaultUserConfigPath stackRoot) (defaultUserConfigPathDeprecated stackRoot) unless exists $ do ensureDir (parent path) liftIO $ S.writeFile (toFilePath path) $ S.concat [ "# This file contains default non-project-specific settings for 'stack', used\n" , "# in all projects. For more information about stack's configuration, see\n" , "# http://docs.haskellstack.org/en/stable/yaml_configuration/\n" , "#\n" , Yaml.encode (mempty :: Object) ] return path packagesParser :: Parser [String] packagesParser = many (strOption (long "package" <> help "Additional packages that must be installed")) stack-1.1.2/src/Stack/Config/Build.hs0000644000000000000000000000537012717707440015460 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} -- | Build configuration module Stack.Config.Build where import Data.Monoid.Extra import Stack.Types -- | Interprets BuildOptsMonoid options. buildOptsFromMonoid :: BuildOptsMonoid -> BuildOpts buildOptsFromMonoid BuildOptsMonoid{..} = BuildOpts { boptsLibProfile = fromFirst (boptsLibProfile defaultBuildOpts) buildMonoidLibProfile , boptsExeProfile = fromFirst (boptsExeProfile defaultBuildOpts) buildMonoidExeProfile , boptsHaddock = fromFirst (boptsHaddock defaultBuildOpts) buildMonoidHaddock , boptsHaddockOpts = haddockOptsFromMonoid buildMonoidHaddockOpts , boptsOpenHaddocks = fromFirst (boptsOpenHaddocks defaultBuildOpts) buildMonoidOpenHaddocks , boptsHaddockDeps = getFirst buildMonoidHaddockDeps , boptsInstallExes = fromFirst (boptsInstallExes defaultBuildOpts) buildMonoidInstallExes , boptsPreFetch = fromFirst (boptsPreFetch defaultBuildOpts) buildMonoidPreFetch , boptsKeepGoing = getFirst buildMonoidKeepGoing , boptsForceDirty = fromFirst (boptsForceDirty defaultBuildOpts) buildMonoidForceDirty , boptsTests = fromFirst (boptsTests defaultBuildOpts) buildMonoidTests , boptsTestOpts = testOptsFromMonoid buildMonoidTestOpts , boptsBenchmarks = fromFirst (boptsBenchmarks defaultBuildOpts) buildMonoidBenchmarks , boptsBenchmarkOpts = benchmarkOptsFromMonoid buildMonoidBenchmarkOpts , boptsReconfigure = fromFirst (boptsReconfigure defaultBuildOpts) buildMonoidReconfigure , boptsCabalVerbose = fromFirst (boptsCabalVerbose defaultBuildOpts) buildMonoidCabalVerbose , boptsSplitObjs = fromFirst (boptsSplitObjs defaultBuildOpts) buildMonoidSplitObjs } haddockOptsFromMonoid :: HaddockOptsMonoid -> HaddockOpts haddockOptsFromMonoid HaddockOptsMonoid{..} = defaultHaddockOpts {toHaddockArgs = toMonoidHaddockArgs} testOptsFromMonoid :: TestOptsMonoid -> TestOpts testOptsFromMonoid TestOptsMonoid{..} = defaultTestOpts { toRerunTests = fromFirst (toRerunTests defaultTestOpts) toMonoidRerunTests , toAdditionalArgs = toMonoidAdditionalArgs , toCoverage = fromFirst (toCoverage defaultTestOpts) toMonoidCoverage , toDisableRun = fromFirst (toDisableRun defaultTestOpts) toMonoidDisableRun } benchmarkOptsFromMonoid :: BenchmarkOptsMonoid -> BenchmarkOpts benchmarkOptsFromMonoid BenchmarkOptsMonoid{..} = defaultBenchmarkOpts { beoAdditionalArgs = getFirst beoMonoidAdditionalArgs , beoDisableRun = fromFirst (beoDisableRun defaultBenchmarkOpts) beoMonoidDisableRun } stack-1.1.2/src/Stack/Config/Urls.hs0000644000000000000000000000137412717707440015346 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Stack.Config.Urls (urlsFromMonoid) where import Stack.Types import Data.Monoid.Extra urlsFromMonoid :: UrlsMonoid -> Urls urlsFromMonoid monoid = Urls (fromFirst defaultLatestSnapshot $ urlsMonoidLatestSnapshot monoid) (fromFirst defaultLtsBuildPlans $ urlsMonoidLtsBuildPlans monoid) (fromFirst defaultNightlyBuildPlans $ urlsMonoidNightlyBuildPlans monoid) where defaultLatestSnapshot = "https://www.stackage.org/download/snapshots.json" defaultLtsBuildPlans = "https://raw.githubusercontent.com/fpco/lts-haskell/master/" defaultNightlyBuildPlans = "https://raw.githubusercontent.com/fpco/stackage-nightly/master/" stack-1.1.2/src/Stack/Config/Docker.hs0000644000000000000000000001133712717707440015630 0ustar0000000000000000{-# LANGUAGE CPP, DeriveDataTypeable, RecordWildCards, TemplateHaskell #-} -- | Docker configuration module Stack.Config.Docker where import Control.Exception.Lifted import Control.Monad import Control.Monad.Catch (throwM, MonadThrow) import Data.List (find) import Data.Maybe import Data.Monoid.Extra import qualified Data.Text as T import Data.Typeable (Typeable) import Distribution.Version (simplifyVersionRange) import Path import Stack.Types -- | Interprets DockerOptsMonoid options. dockerOptsFromMonoid :: MonadThrow m => Maybe Project -> Path Abs Dir -> Maybe AbstractResolver -> DockerOptsMonoid -> m DockerOpts dockerOptsFromMonoid mproject stackRoot maresolver DockerOptsMonoid{..} = do let dockerEnable = fromFirst (getAny dockerMonoidDefaultEnable) dockerMonoidEnable dockerImage = let mresolver = case maresolver of Just (ARResolver resolver) -> Just resolver Just aresolver -> throw (ResolverNotSupportedException $ show aresolver) Nothing -> fmap projectResolver mproject defaultTag = case mresolver of Nothing -> "" Just resolver -> case resolver of ResolverSnapshot n@(LTS _ _) -> ":" ++ T.unpack (renderSnapName n) _ -> throw (ResolverNotSupportedException $ show resolver) in case getFirst dockerMonoidRepoOrImage of Nothing -> "fpco/stack-build" ++ defaultTag Just (DockerMonoidImage image) -> image Just (DockerMonoidRepo repo) -> case find (`elem` (":@" :: String)) repo of Just _ -- Repo already specified a tag or digest, so don't append default -> repo Nothing -> repo ++ defaultTag dockerRegistryLogin = fromFirst (isJust (emptyToNothing (getFirst dockerMonoidRegistryUsername))) dockerMonoidRegistryLogin dockerRegistryUsername = emptyToNothing (getFirst dockerMonoidRegistryUsername) dockerRegistryPassword = emptyToNothing (getFirst dockerMonoidRegistryPassword) dockerAutoPull = fromFirst False dockerMonoidAutoPull dockerDetach = fromFirst False dockerMonoidDetach dockerPersist = fromFirst False dockerMonoidPersist dockerContainerName = emptyToNothing (getFirst dockerMonoidContainerName) dockerRunArgs = dockerMonoidRunArgs dockerMount = dockerMonoidMount dockerEnv = dockerMonoidEnv dockerSetUser = getFirst dockerMonoidSetUser dockerRequireDockerVersion = simplifyVersionRange (getIntersectingVersionRange dockerMonoidRequireDockerVersion) dockerDatabasePath <- case getFirst dockerMonoidDatabasePath of Nothing -> return $ stackRoot $(mkRelFile "docker.db") Just fp -> case parseAbsFile fp of Left e -> throwM (InvalidDatabasePathException e) Right p -> return p dockerStackExe <- case getFirst dockerMonoidStackExe of Just e -> liftM Just (parseDockerStackExe e) Nothing -> return Nothing return DockerOpts{..} where emptyToNothing Nothing = Nothing emptyToNothing (Just s) | null s = Nothing | otherwise = Just s -- | Exceptions thrown by Stack.Docker.Config. data StackDockerConfigException = ResolverNotSupportedException String -- ^ Only LTS resolvers are supported for default image tag. | InvalidDatabasePathException SomeException -- ^ Invalid global database path. deriving (Typeable) -- | Exception instance for StackDockerConfigException. instance Exception StackDockerConfigException -- | Show instance for StackDockerConfigException. instance Show StackDockerConfigException where show (ResolverNotSupportedException resolver) = concat [ "Resolver not supported for Docker images:\n " , resolver , "\nUse an LTS resolver, or set the '" , T.unpack dockerImageArgName , "' explicitly, in your configuration file."] show (InvalidDatabasePathException ex) = concat ["Invalid database path: ", show ex] stack-1.1.2/src/Stack/Config/Nix.hs0000644000000000000000000000564512717707440015164 0ustar0000000000000000{-# LANGUAGE RecordWildCards, DeriveDataTypeable, OverloadedStrings #-} -- | Nix configuration module Stack.Config.Nix (nixOptsFromMonoid ,nixCompiler ,StackNixException(..) ) where import Control.Applicative import Control.Monad (join, when) import Data.Maybe import Data.Monoid.Extra import qualified Data.Text as T import Data.Typeable import Distribution.System (OS (..)) import Stack.Types import Control.Exception.Lifted import Control.Monad.Catch (throwM,MonadCatch) import Prelude -- | Interprets NixOptsMonoid options. nixOptsFromMonoid :: (Monad m, MonadCatch m) => NixOptsMonoid -> OS -> m NixOpts nixOptsFromMonoid NixOptsMonoid{..} os = do let nixEnable = fromFirst (getAny nixMonoidDefaultEnable) nixMonoidEnable defaultPure = case os of OSX -> False _ -> True nixPureShell = fromFirst defaultPure nixMonoidPureShell nixPackages = fromFirst [] nixMonoidPackages nixInitFile = getFirst nixMonoidInitFile nixShellOptions = fromFirst [] nixMonoidShellOptions ++ prefixAll (T.pack "-I") (fromFirst [] nixMonoidPath) when (not (null nixPackages) && isJust nixInitFile) $ throwM NixCannotUseShellFileAndPackagesException return NixOpts{..} where prefixAll p (x:xs) = p : x : prefixAll p xs prefixAll _ _ = [] nixCompiler :: Config -> Maybe Resolver -> Maybe CompilerVersion -> T.Text nixCompiler config resolverOverride compilerOverride = let mproject = fst <$> configMaybeProject config mresolver = resolverOverride <|> fmap projectResolver mproject mcompiler = compilerOverride <|> join (fmap projectCompiler mproject) -- These are the latest minor versions for each respective major version available in nixpkgs fixMinor "8.0" = "8.0.1" fixMinor "7.10" = "7.10.3" fixMinor "7.8" = "7.8.4" fixMinor "7.6" = "7.6.3" fixMinor "7.4" = "7.4.2" fixMinor "7.2" = "7.2.2" fixMinor "6.12" = "6.12.3" fixMinor "6.10" = "6.10.4" fixMinor v = v nixCompilerFromVersion v = T.append (T.pack "haskell.compiler.ghc") (T.filter (/= '.') (fixMinor (versionText v))) in case (mresolver, mcompiler) of (_, Just (GhcVersion v)) -> nixCompilerFromVersion v (Just (ResolverCompiler (GhcVersion v)), _) -> nixCompilerFromVersion v (Just (ResolverSnapshot (LTS x y)), _) -> T.pack ("haskell.packages.lts-" ++ show x ++ "_" ++ show y ++ ".ghc") _ -> T.pack "ghc" -- Exceptions thown specifically by Stack.Nix data StackNixException = NixCannotUseShellFileAndPackagesException -- ^ Nix can't be given packages and a shell file at the same time deriving (Typeable) instance Exception StackNixException instance Show StackNixException where show NixCannotUseShellFileAndPackagesException = "You cannot have packages and a shell-file filled at the same time in your nix-shell configuration." stack-1.1.2/src/Stack/ConfigCmd.hs0000644000000000000000000000415612717707440015046 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Make changes to the stack yaml file module Stack.ConfigCmd (ConfigCmdSet(..) ,cfgCmdSet ,cfgCmdSetName ,cfgCmdName) where import Control.Monad.Catch (MonadMask, throwM) import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.ByteString as S import qualified Data.HashMap.Strict as HMap import qualified Data.Yaml as Yaml import Network.HTTP.Client.Conduit (HasHttpManager) import Path import Stack.BuildPlan import Stack.Config (makeConcreteResolver) import Stack.Types data ConfigCmdSet = ConfigCmdSetResolver AbstractResolver cfgCmdSet :: ( MonadIO m , MonadBaseControl IO m , MonadMask m , MonadReader env m , HasBuildConfig env , HasHttpManager env , HasGHCVariant env , MonadLogger m) => ConfigCmdSet -> m () cfgCmdSet (ConfigCmdSetResolver newResolver) = do stackYaml <- fmap bcStackYaml (asks getBuildConfig) let stackYamlFp = toFilePath stackYaml -- We don't need to worry about checking for a valid yaml here (projectYamlConfig :: Yaml.Object) <- liftIO (Yaml.decodeFileEither stackYamlFp) >>= either throwM return -- TODO: custom snapshot support? newResolverText <- fmap resolverName (makeConcreteResolver newResolver) -- We checking here that the snapshot actually exists snap <- parseSnapName newResolverText _ <- loadMiniBuildPlan snap let projectYamlConfig' = HMap.insert "resolver" (Yaml.String newResolverText) projectYamlConfig liftIO (S.writeFile stackYamlFp (Yaml.encode projectYamlConfig')) return () cfgCmdName :: String cfgCmdName = "config" cfgCmdSetName :: String cfgCmdSetName = "set" stack-1.1.2/src/Stack/Constants.hs0000644000000000000000000002521112717707440015164 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} -- | Constants used throughout the project. module Stack.Constants (buildPlanDir ,distDirFromDir ,workDirFromDir ,distRelativeDir ,haskellModuleExts ,imageStagingDir ,projectDockerSandboxDir ,stackDotYaml ,stackRootEnvVar ,stackRootOptionName ,deprecatedStackRootOptionName ,inContainerEnvVar ,configCacheFile ,configCabalMod ,buildCacheFile ,testSuccessFile ,testBuiltFile ,stackProgName ,stackProgNameUpper ,wiredInPackages ,ghcjsBootPackages ,cabalPackageName ,implicitGlobalProjectDirDeprecated ,implicitGlobalProjectDir ,hpcRelativeDir ,hpcDirFromDir ,objectInterfaceDir ,templatesDir ,defaultUserConfigPathDeprecated ,defaultUserConfigPath ,defaultGlobalConfigPathDeprecated ,defaultGlobalConfigPath ,platformVariantEnvVar ) where import Control.Monad.Catch (MonadThrow) import Control.Monad.Reader import Data.Char (toUpper) import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.Text (Text) import Path as FL import Prelude import Stack.Types.Compiler import Stack.Types.Config import Stack.Types.PackageIdentifier import Stack.Types.PackageName -- | Extensions for anything that can be a Haskell module. haskellModuleExts :: [Text] haskellModuleExts = haskellFileExts ++ haskellPreprocessorExts -- | Extensions used for Haskell modules. Excludes preprocessor ones. haskellFileExts :: [Text] haskellFileExts = ["hs", "hsc", "lhs"] -- | Extensions for modules that are preprocessed by common preprocessors. haskellPreprocessorExts :: [Text] haskellPreprocessorExts = ["gc", "chs", "hsc", "x", "y", "ly", "cpphs"] -- | Output .o/.hi directory. objectInterfaceDir :: (MonadReader env m, HasConfig env) => BuildConfig -> m (Path Abs Dir) objectInterfaceDir bconfig = do bcwd <- bcWorkDir bconfig return (bcwd $(mkRelDir "odir/")) -- | The filename used for dirtiness check of source files. buildCacheFile :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -- ^ Package directory. -> m (Path Abs File) buildCacheFile dir = liftM ( $(mkRelFile "stack-build-cache")) (distDirFromDir dir) -- | The filename used to mark tests as having succeeded testSuccessFile :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -- ^ Package directory -> m (Path Abs File) testSuccessFile dir = liftM ( $(mkRelFile "stack-test-success")) (distDirFromDir dir) -- | The filename used to mark tests as having built testBuiltFile :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -- ^ Package directory -> m (Path Abs File) testBuiltFile dir = liftM ( $(mkRelFile "stack-test-built")) (distDirFromDir dir) -- | The filename used for dirtiness check of config. configCacheFile :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -- ^ Package directory. -> m (Path Abs File) configCacheFile dir = liftM ( $(mkRelFile "stack-config-cache")) (distDirFromDir dir) -- | The filename used for modification check of .cabal configCabalMod :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -- ^ Package directory. -> m (Path Abs File) configCabalMod dir = liftM ( $(mkRelFile "stack-cabal-mod")) (distDirFromDir dir) -- | Directory for HPC work. hpcDirFromDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -- ^ Package directory. -> m (Path Abs Dir) hpcDirFromDir fp = liftM (fp ) hpcRelativeDir -- | Relative location of directory for HPC work. hpcRelativeDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Rel Dir) hpcRelativeDir = liftM ( $(mkRelDir "hpc")) distRelativeDir -- | Package's build artifacts directory. distDirFromDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -> m (Path Abs Dir) distDirFromDir fp = liftM (fp ) distRelativeDir -- | Package's working directory. workDirFromDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -> m (Path Abs Dir) workDirFromDir fp = liftM (fp ) getWorkDir -- | Directory for project templates. templatesDir :: Config -> Path Abs Dir templatesDir config = configStackRoot config $(mkRelDir "templates") -- | Relative location of build artifacts. distRelativeDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Rel Dir) distRelativeDir = do cabalPkgVer <- asks (envConfigCabalVersion . getEnvConfig) platform <- platformGhcRelDir wc <- getWhichCompiler -- Cabal version, suffixed with "_ghcjs" if we're using GHCJS. envDir <- parseRelDir $ (if wc == Ghcjs then (++ "_ghcjs") else id) $ packageIdentifierString $ PackageIdentifier cabalPackageName cabalPkgVer platformAndCabal <- useShaPathOnWindows (platform envDir) workDir <- getWorkDir return $ workDir $(mkRelDir "dist") platformAndCabal -- | Docker sandbox from project root. projectDockerSandboxDir :: (MonadReader env m, HasConfig env) => Path Abs Dir -- ^ Project root -> m (Path Abs Dir) -- ^ Docker sandbox projectDockerSandboxDir projectRoot = do workDir <- getWorkDir return $ projectRoot workDir $(mkRelDir "docker/") -- | Image staging dir from project root. imageStagingDir :: (MonadReader env m, HasConfig env, MonadThrow m) => Path Abs Dir -- ^ Project root -> Int -- ^ Index of image -> m (Path Abs Dir) -- ^ Docker sandbox imageStagingDir projectRoot imageIdx = do workDir <- getWorkDir idxRelDir <- parseRelDir (show imageIdx) return $ projectRoot workDir $(mkRelDir "image") idxRelDir -- | Name of the 'stack' program, uppercased stackProgNameUpper :: String stackProgNameUpper = map toUpper stackProgName -- | Name of the 'stack' program. stackProgName :: String stackProgName = "stack" -- | The filename used for the stack config file. stackDotYaml :: Path Rel File stackDotYaml = $(mkRelFile "stack.yaml") -- | Environment variable used to override the '~/.stack' location. stackRootEnvVar :: String stackRootEnvVar = "STACK_ROOT" -- | Option name for the global stack root. stackRootOptionName :: String stackRootOptionName = "stack-root" -- | Deprecated option name for the global stack root. -- -- Deprecated since stack-1.1.0. -- -- TODO: Remove occurences of this variable and use 'stackRootOptionName' only -- after an appropriate deprecation period. deprecatedStackRootOptionName :: String deprecatedStackRootOptionName = "global-stack-root" -- | Environment variable used to indicate stack is running in container. inContainerEnvVar :: String inContainerEnvVar = stackProgNameUpper ++ "_IN_CONTAINER" -- See https://downloads.haskell.org/~ghc/7.10.1/docs/html/libraries/ghc/src/Module.html#integerPackageKey wiredInPackages :: HashSet PackageName wiredInPackages = maybe (error "Parse error in wiredInPackages") HashSet.fromList mparsed where mparsed = mapM parsePackageName [ "ghc-prim" , "integer-gmp" , "integer-simple" , "base" , "rts" , "template-haskell" , "dph-seq" , "dph-par" , "ghc" , "interactive" ] -- TODO: Get this unwieldy list out of here and into a datafile -- generated by GHCJS! See https://github.com/ghcjs/ghcjs/issues/434 ghcjsBootPackages :: HashSet PackageName ghcjsBootPackages = maybe (error "Parse error in ghcjsBootPackages") HashSet.fromList mparsed where mparsed = mapM parsePackageName -- stage1a [ "array" , "base" , "binary" , "bytestring" , "containers" , "deepseq" , "integer-gmp" , "pretty" , "primitive" , "integer-gmp" , "pretty" , "primitive" , "template-haskell" , "transformers" -- stage1b , "directory" , "filepath" , "old-locale" , "process" , "time" -- stage2 , "async" , "aeson" , "attoparsec" , "case-insensitive" , "dlist" , "extensible-exceptions" , "hashable" , "mtl" , "old-time" , "parallel" , "scientific" , "stm" , "syb" , "text" , "unordered-containers" , "vector" ] -- | Just to avoid repetition and magic strings. cabalPackageName :: PackageName cabalPackageName = $(mkPackageName "Cabal") -- | Deprecated implicit global project directory used when outside of a project. implicitGlobalProjectDirDeprecated :: Path Abs Dir -- ^ Stack root. -> Path Abs Dir implicitGlobalProjectDirDeprecated p = p $(mkRelDir "global") -- | Implicit global project directory used when outside of a project. -- Normally, @getImplicitGlobalProjectDir@ should be used instead. implicitGlobalProjectDir :: Path Abs Dir -- ^ Stack root. -> Path Abs Dir implicitGlobalProjectDir p = p $(mkRelDir "global-project") -- | Deprecated default global config path. defaultUserConfigPathDeprecated :: Path Abs Dir -> Path Abs File defaultUserConfigPathDeprecated = ( $(mkRelFile "stack.yaml")) -- | Default global config path. -- Normally, @getDefaultUserConfigPath@ should be used instead. defaultUserConfigPath :: Path Abs Dir -> Path Abs File defaultUserConfigPath = ( $(mkRelFile "config.yaml")) -- | Deprecated default global config path. -- Note that this will be @Nothing@ on Windows, which is by design. defaultGlobalConfigPathDeprecated :: Maybe (Path Abs File) defaultGlobalConfigPathDeprecated = parseAbsFile "/etc/stack/config" -- | Default global config path. -- Normally, @getDefaultGlobalConfigPath@ should be used instead. -- Note that this will be @Nothing@ on Windows, which is by design. defaultGlobalConfigPath :: Maybe (Path Abs File) defaultGlobalConfigPath = parseAbsFile "/etc/stack/config.yaml" -- | Path where build plans are stored. buildPlanDir :: Path Abs Dir -- ^ Stack root -> Path Abs Dir buildPlanDir = ( $(mkRelDir "build-plan")) -- | Environment variable that stores a variant to append to platform-specific directory -- names. Used to ensure incompatible binaries aren't shared between Docker builds and host platformVariantEnvVar :: String platformVariantEnvVar = stackProgNameUpper ++ "_PLATFORM_VARIANT" stack-1.1.2/src/Stack/Coverage.hs0000644000000000000000000004641412717707440014753 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} -- | Generate HPC (Haskell Program Coverage) reports module Stack.Coverage ( deleteHpcReports , updateTixFile , generateHpcReport , HpcReportOpts(..) , generateHpcReportForTargets , generateHpcUnifiedReport , generateHpcMarkupIndex ) where import Control.Applicative import Control.Exception.Lifted import Control.Monad (liftM, when, unless, void) import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Trans.Resource import qualified Data.ByteString.Char8 as S8 import Data.Foldable (forM_, asum, toList) import Data.Function import Data.List import qualified Data.Map.Strict as Map import Data.Maybe import Data.Maybe.Extra (mapMaybeM) import Data.Monoid ((<>)) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as LT import Data.Traversable (forM) import Path import Path.Extra (toFilePathNoTrailingSep) import Path.IO import Prelude hiding (FilePath, writeFile) import Stack.Build.Source (parseTargetsFromBuildOpts) import Stack.Build.Target import Stack.Constants import Stack.Package import Stack.Types import System.FilePath (isPathSeparator) import System.Process.Read import Text.Hastache (htmlEscape) import Trace.Hpc.Tix -- | Invoked at the beginning of running with "--coverage" deleteHpcReports :: (MonadIO m, MonadMask m, MonadReader env m, HasEnvConfig env) => m () deleteHpcReports = do hpcDir <- hpcReportDir ignoringAbsence (removeDirRecur hpcDir) -- | Move a tix file into a sub-directory of the hpc report directory. Deletes the old one if one is -- present. updateTixFile :: (MonadIO m,MonadReader env m,MonadLogger m,MonadBaseControl IO m,MonadMask m,HasEnvConfig env) => PackageName -> Path Abs File -> String -> m () updateTixFile pkgName tixSrc testName = do exists <- doesFileExist tixSrc when exists $ do tixDest <- tixFilePath pkgName testName ignoringAbsence (removeFile tixDest) ensureDir (parent tixDest) -- Remove exe modules because they are problematic. This could be revisited if there's a GHC -- version that fixes https://ghc.haskell.org/trac/ghc/ticket/1853 mtix <- readTixOrLog tixSrc case mtix of Nothing -> $logError $ "Failed to read " <> T.pack (toFilePath tixSrc) Just tix -> do liftIO $ writeTix (toFilePath tixDest) (removeExeModules tix) ignoringAbsence (removeFile tixSrc) -- | Get the directory used for hpc reports for the given pkgId. hpcPkgPath :: (MonadIO m,MonadReader env m,MonadMask m,HasEnvConfig env) => PackageName -> m (Path Abs Dir) hpcPkgPath pkgName = do outputDir <- hpcReportDir pkgNameRel <- parseRelDir (packageNameString pkgName) return (outputDir pkgNameRel) -- | Get the tix file location, given the name of the file (without extension), and the package -- identifier string. tixFilePath :: (MonadIO m,MonadReader env m,MonadMask m,HasEnvConfig env) => PackageName -> String -> m (Path Abs File) tixFilePath pkgName testName = do pkgPath <- hpcPkgPath pkgName tixRel <- parseRelFile (testName ++ "/" ++ testName ++ ".tix") return (pkgPath tixRel) -- | Generates the HTML coverage report and shows a textual coverage summary for a package. generateHpcReport :: (MonadIO m,MonadReader env m,MonadLogger m,MonadBaseControl IO m,MonadMask m,HasEnvConfig env) => Path Abs Dir -> Package -> [Text] -> m () generateHpcReport pkgDir package tests = do -- If we're using > GHC 7.10, the hpc 'include' parameter must specify a ghc package key. See -- https://github.com/commercialhaskell/stack/issues/785 let pkgName = packageNameText (packageName package) pkgId = packageIdentifierString (packageIdentifier package) compilerVersion <- asks (envConfigCompilerVersion . getEnvConfig) eincludeName <- -- Pre-7.8 uses plain PKG-version in tix files. if getGhcVersion compilerVersion < $(mkVersion "7.10") then return $ Right $ Just pkgId -- We don't expect to find a package key if there is no library. else if not (packageHasLibrary package) then return $ Right Nothing -- Look in the inplace DB for the package key. -- See https://github.com/commercialhaskell/stack/issues/1181#issuecomment-148968986 else do mghcPkgKey <- findPackageKeyForBuiltPackage pkgDir (packageIdentifier package) case mghcPkgKey of Nothing -> do let msg = "Failed to find GHC package key for " <> pkgName $logError msg return $ Left msg Just ghcPkgKey -> return $ Right $ Just $ T.unpack ghcPkgKey forM_ tests $ \testName -> do tixSrc <- tixFilePath (packageName package) (T.unpack testName) let report = "coverage report for " <> pkgName <> "'s test-suite \"" <> testName <> "\"" reportDir = parent tixSrc case eincludeName of Left err -> generateHpcErrorReport reportDir (sanitize (T.unpack err)) -- Restrict to just the current library code, if there is a library in the package (see -- #634 - this will likely be customizable in the future) Right mincludeName -> do let extraArgs = case mincludeName of Just includeName -> ["--include", includeName ++ ":"] Nothing -> [] generateHpcReportInternal tixSrc reportDir report extraArgs extraArgs generateHpcReportInternal :: (MonadIO m,MonadReader env m,MonadLogger m,MonadBaseControl IO m,MonadMask m,HasEnvConfig env) => Path Abs File -> Path Abs Dir -> Text -> [String] -> [String] -> m () generateHpcReportInternal tixSrc reportDir report extraMarkupArgs extraReportArgs = do -- If a .tix file exists, move it to the HPC output directory and generate a report for it. tixFileExists <- doesFileExist tixSrc if not tixFileExists then $logError $ T.concat [ "Didn't find .tix for " , report , " - expected to find it at " , T.pack (toFilePath tixSrc) , "." ] else (`catch` \err -> do let msg = show (err :: ReadProcessException) $logError (T.pack msg) generateHpcErrorReport reportDir $ sanitize msg) $ (`onException` $logError ("Error occurred while producing " <> report)) $ do -- Directories for .mix files. hpcRelDir <- hpcRelativeDir -- Compute arguments used for both "hpc markup" and "hpc report". pkgDirs <- Map.keys . envConfigPackages <$> asks getEnvConfig let args = -- Use index files from all packages (allows cross-package coverage results). concatMap (\x -> ["--srcdir", toFilePathNoTrailingSep x]) pkgDirs ++ -- Look for index files in the correct dir (relative to each pkgdir). ["--hpcdir", toFilePathNoTrailingSep hpcRelDir, "--reset-hpcdirs"] menv <- getMinimalEnvOverride $logInfo $ "Generating " <> report outputLines <- liftM (map (S8.filter (/= '\r')) . S8.lines) $ readProcessStdout Nothing menv "hpc" ( "report" : toFilePath tixSrc : (args ++ extraReportArgs) ) if all ("(0/0)" `S8.isSuffixOf`) outputLines then do let msg html = T.concat [ "Error: The " , report , " did not consider any code. One possible cause of this is" , " if your test-suite builds the library code (see stack " , if html then "" else "" , "issue #1008" , if html then "" else "" , "). It may also indicate a bug in stack or" , " the hpc program. Please report this issue if you think" , " your coverage report should have meaningful results." ] $logError (msg False) generateHpcErrorReport reportDir (msg True) else do -- Print output, stripping @\r@ characters because Windows. forM_ outputLines ($logInfo . T.decodeUtf8) $logInfo ("The " <> report <> " is available at " <> T.pack (toFilePath (reportDir $(mkRelFile "hpc_index.html")))) -- Generate the markup. void $ readProcessStdout Nothing menv "hpc" ( "markup" : toFilePath tixSrc : ("--destdir=" ++ toFilePathNoTrailingSep reportDir) : (args ++ extraMarkupArgs) ) data HpcReportOpts = HpcReportOpts { hroptsInputs :: [Text] , hroptsAll :: Bool , hroptsDestDir :: Maybe String } deriving (Show) generateHpcReportForTargets :: (MonadIO m, MonadReader env m, MonadBaseControl IO m, MonadMask m, MonadLogger m, HasEnvConfig env) => HpcReportOpts -> m () generateHpcReportForTargets opts = do let (tixFiles, targetNames) = partition (".tix" `T.isSuffixOf`) (hroptsInputs opts) targetTixFiles <- -- When there aren't any package component arguments, then -- don't default to all package components. if not (hroptsAll opts) && null targetNames then return [] else do when (hroptsAll opts && not (null targetNames)) $ $logWarn $ "Since --all is used, it is redundant to specify these targets: " <> T.pack (show targetNames) (_,_,targets) <- parseTargetsFromBuildOpts AllowNoTargets defaultBuildOptsCLI { boptsCLITargets = if hroptsAll opts then [] else targetNames } liftM concat $ forM (Map.toList targets) $ \(name, target) -> case target of STUnknown -> fail $ packageNameString name ++ " isn't a known local page" STNonLocal -> fail $ "Expected a local package, but " ++ packageNameString name ++ " is either an extra-dep or in the snapshot." STLocalComps comps -> do pkgPath <- hpcPkgPath name forM (toList comps) $ \nc -> case nc of CTest testName -> liftM (pkgPath ) $ parseRelFile (T.unpack testName ++ ".tix") _ -> fail $ "Can't specify anything except test-suites as hpc report targets (" ++ packageNameString name ++ " is used with a non test-suite target)" STLocalAll -> do pkgPath <- hpcPkgPath name exists <- doesDirExist pkgPath if exists then do (_, files) <- listDir pkgPath return (filter ((".tix" `isSuffixOf`) . toFilePath) files) else return [] tixPaths <- liftM (++ targetTixFiles) $ mapM (resolveFile' . T.unpack) tixFiles when (null tixPaths) $ fail "Not generating combined report, because no targets or tix files are specified." reportDir <- case hroptsDestDir opts of Nothing -> liftM ( $(mkRelDir "combined/custom")) hpcReportDir Just destDir -> do dest <- resolveDir' destDir ensureDir dest return dest generateUnionReport "combined report" reportDir tixPaths generateHpcUnifiedReport :: (MonadIO m,MonadReader env m,MonadLogger m,MonadBaseControl IO m,MonadMask m,HasEnvConfig env) => m () generateHpcUnifiedReport = do outputDir <- hpcReportDir ensureDir outputDir (dirs, _) <- listDir outputDir tixFiles <- liftM (concat . concat) $ forM (filter (("combined" /=) . dirnameString) dirs) $ \dir -> do (dirs', _) <- listDir dir forM dirs' $ \dir' -> do (_, files) <- listDir dir' return (filter ((".tix" `isSuffixOf`) . toFilePath) files) let reportDir = outputDir $(mkRelDir "combined/all") if length tixFiles < 2 then $logInfo $ T.concat [ if null tixFiles then "No tix files" else "Only one tix file" , " found in " , T.pack (toFilePath outputDir) , ", so not generating a unified coverage report." ] else generateUnionReport "unified report" reportDir tixFiles generateUnionReport :: (MonadIO m,MonadReader env m,MonadLogger m,MonadBaseControl IO m,MonadMask m,HasEnvConfig env) => Text -> Path Abs Dir -> [Path Abs File] -> m () generateUnionReport report reportDir tixFiles = do (errs, tix) <- fmap (unionTixes . map removeExeModules) (mapMaybeM readTixOrLog tixFiles) $logDebug $ "Using the following tix files: " <> T.pack (show tixFiles) unless (null errs) $ $logWarn $ T.concat $ "The following modules are left out of the " : report : " due to version mismatches: " : intersperse ", " (map T.pack errs) tixDest <- liftM (reportDir ) $ parseRelFile (dirnameString reportDir ++ ".tix") ensureDir (parent tixDest) liftIO $ writeTix (toFilePath tixDest) tix generateHpcReportInternal tixDest reportDir report [] [] readTixOrLog :: (MonadLogger m, MonadIO m, MonadBaseControl IO m) => Path b File -> m (Maybe Tix) readTixOrLog path = do mtix <- liftIO (readTix (toFilePath path)) `catch` \errorCall -> do $logError $ "Error while reading tix: " <> T.pack (show (errorCall :: ErrorCall)) return Nothing when (isNothing mtix) $ $logError $ "Failed to read tix file " <> T.pack (toFilePath path) return mtix -- | Module names which contain '/' have a package name, and so they weren't built into the -- executable. removeExeModules :: Tix -> Tix removeExeModules (Tix ms) = Tix (filter (\(TixModule name _ _ _) -> '/' `elem` name) ms) unionTixes :: [Tix] -> ([String], Tix) unionTixes tixes = (Map.keys errs, Tix (Map.elems outputs)) where (errs, outputs) = Map.mapEither id $ Map.unionsWith merge $ map toMap tixes toMap (Tix ms) = Map.fromList (map (\x@(TixModule k _ _ _) -> (k, Right x)) ms) merge (Right (TixModule k hash1 len1 tix1)) (Right (TixModule _ hash2 len2 tix2)) | hash1 == hash2 && len1 == len2 = Right (TixModule k hash1 len1 (zipWith (+) tix1 tix2)) merge _ _ = Left () generateHpcMarkupIndex :: (MonadIO m,MonadReader env m,MonadLogger m,MonadMask m,HasEnvConfig env) => m () generateHpcMarkupIndex = do outputDir <- hpcReportDir let outputFile = outputDir $(mkRelFile "index.html") ensureDir outputDir (dirs, _) <- listDir outputDir rows <- liftM (catMaybes . concat) $ forM dirs $ \dir -> do (subdirs, _) <- listDir dir forM subdirs $ \subdir -> do let indexPath = subdir $(mkRelFile "hpc_index.html") exists' <- doesFileExist indexPath if not exists' then return Nothing else do relPath <- stripDir outputDir indexPath let package = dirname dir testsuite = dirname subdir return $ Just $ T.concat [ "" , pathToHtml package , "" , pathToHtml testsuite , "" ] liftIO $ T.writeFile (toFilePath outputFile) $ T.concat $ [ "" -- Part of the css from HPC's output HTML , "" , "" , "" ] ++ (if null rows then [ "No hpc_index.html files found in \"" , pathToHtml outputDir , "\"." ] else [ "" , "

NOTE: This is merely a listing of the html files found in the coverage reports directory. Some of these reports may be old.

" , "" ] ++ rows ++ ["
PackageTestSuiteModification Time
"]) ++ [""] unless (null rows) $ $logInfo $ "\nAn index of the generated HTML coverage reports is available at " <> T.pack (toFilePath outputFile) generateHpcErrorReport :: MonadIO m => Path Abs Dir -> Text -> m () generateHpcErrorReport dir err = do ensureDir dir liftIO $ T.writeFile (toFilePath (dir $(mkRelFile "hpc_index.html"))) $ T.concat [ "" , "

HPC Report Generation Error

" , "

" , err , "

" , "" ] pathToHtml :: Path b t -> Text pathToHtml = T.dropWhileEnd (=='/') . sanitize . toFilePath sanitize :: String -> Text sanitize = LT.toStrict . htmlEscape . LT.pack dirnameString :: Path r Dir -> String dirnameString = dropWhileEnd isPathSeparator . toFilePath . dirname findPackageKeyForBuiltPackage :: (MonadIO m, MonadReader env m, MonadThrow m, HasEnvConfig env) => Path Abs Dir -> PackageIdentifier -> m (Maybe Text) findPackageKeyForBuiltPackage pkgDir pkgId = do distDir <- distDirFromDir pkgDir path <- liftM (distDir ) $ parseRelFile ("package.conf.inplace/" ++ packageIdentifierString pkgId ++ "-inplace.conf") exists <- doesFileExist path if exists then do contents <- liftIO $ T.readFile (toFilePath path) return $ asum (map (T.stripPrefix "key: ") (T.lines contents)) else return Nothing stack-1.1.2/src/Stack/Docker.hs0000644000000000000000000013745212717707440014432 0ustar0000000000000000{-# LANGUAGE CPP, ConstraintKinds, DeriveDataTypeable, FlexibleContexts, MultiWayIf, NamedFieldPuns, OverloadedStrings, PackageImports, RankNTypes, RecordWildCards, ScopedTypeVariables, TemplateHaskell, TupleSections #-} -- | Run commands in Docker containers module Stack.Docker (cleanup ,CleanupOpts(..) ,CleanupAction(..) ,dockerCleanupCmdName ,dockerCmdName ,dockerHelpOptName ,dockerPullCmdName ,entrypoint ,preventInContainer ,pull ,reexecWithOptionalContainer ,reset ,reExecArgName ,StackDockerException(..) ) where import Control.Applicative import Control.Concurrent.MVar.Lifted (MVar,modifyMVar_,newMVar) import Control.Exception.Lifted import Control.Monad import Control.Monad.Catch (MonadThrow,throwM,MonadCatch,MonadMask) import Control.Monad.IO.Class (MonadIO,liftIO) import Control.Monad.Logger (MonadLogger,logError,logInfo,logWarn) import Control.Monad.Reader (MonadReader,asks,runReaderT) import Control.Monad.Writer (execWriter,runWriter,tell) import Control.Monad.Trans.Control (MonadBaseControl) import qualified "cryptohash" Crypto.Hash as Hash import Data.Aeson.Extended (FromJSON(..),(.:),(.:?),(.!=),eitherDecode) import Data.ByteString.Builder (stringUtf8,charUtf8,toLazyByteString) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Char (isSpace,toUpper,isAscii,isDigit) import Data.Conduit.List (sinkNull) import Data.List (dropWhileEnd,intercalate,isPrefixOf,isInfixOf,foldl') import Data.List.Extra (trim) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe import Data.Ord (Down(..)) import Data.Streaming.Process (ProcessExitedUnsuccessfully(..)) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Data.Time (UTCTime,LocalTime(..),diffDays,utcToLocalTime,getZonedTime,ZonedTime(..)) import Data.Typeable (Typeable) import Data.Version (showVersion) import Distribution.System (Platform (Platform),Arch (X86_64),OS (Linux)) import Distribution.Text (display) import GHC.Exts (sortWith) import Network.HTTP.Client.Conduit (HasHttpManager) import Path import Path.Extra (toFilePathNoTrailingSep) import Path.IO hiding (canonicalizePath) import qualified Paths_stack as Meta import Prelude -- Fix redundant import warnings import Stack.Config (getInContainer) import Stack.Constants import Stack.Docker.GlobalDB import Stack.Types import Stack.Types.Internal import Stack.Setup (ensureDockerStackExe) import System.Directory (canonicalizePath,getHomeDirectory) import System.Environment (getEnv,getEnvironment,getProgName,getArgs,getExecutablePath) import System.Exit (exitSuccess, exitWith) import qualified System.FilePath as FP import System.IO (stderr,stdin,stdout,hIsTerminalDevice) import System.IO.Error (isDoesNotExistError) import System.IO.Unsafe (unsafePerformIO) import qualified System.PosixCompat.User as User import qualified System.PosixCompat.Files as Files import System.Process.PagerEditor (editByteString) import System.Process.Read import System.Process.Run import System.Process (CreateProcess(delegate_ctlc)) import Text.Printf (printf) #ifndef WINDOWS import Control.Concurrent (threadDelay) import Control.Monad.Trans.Control (liftBaseWith) import System.Posix.Signals import qualified System.Posix.User as PosixUser #endif -- | If Docker is enabled, re-runs the currently running OS command in a Docker container. -- Otherwise, runs the inner action. -- -- This takes an optional release action which should be taken IFF control is -- transfering away from the current process to the intra-container one. The main use -- for this is releasing a lock. After launching reexecution, the host process becomes -- nothing but an manager for the call into docker and thus may not hold the lock. reexecWithOptionalContainer :: M env m => Maybe (Path Abs Dir) -> Maybe (m ()) -> IO () -> Maybe (m ()) -> Maybe (m ()) -> m () reexecWithOptionalContainer mprojectRoot = execWithOptionalContainer mprojectRoot getCmdArgs where getCmdArgs docker envOverride imageInfo isRemoteDocker = do config <- asks getConfig deUser <- if fromMaybe (not isRemoteDocker) (dockerSetUser docker) then liftIO $ do duUid <- User.getEffectiveUserID duGid <- User.getEffectiveGroupID duGroups <- User.getGroups duUmask <- Files.setFileCreationMask 0o022 -- Only way to get old umask seems to be to change it, so set it back afterward _ <- Files.setFileCreationMask duUmask return (Just DockerUser{..}) else return Nothing args <- fmap (["--" ++ reExecArgName ++ "=" ++ showVersion Meta.version ,"--" ++ dockerEntrypointArgName ,show DockerEntrypoint{..}] ++) (liftIO getArgs) case dockerStackExe (configDocker config) of Just DockerStackExeHost | configPlatform config == dockerContainerPlatform -> do exePath <- liftIO getExecutablePath cmdArgs args exePath | otherwise -> throwM UnsupportedStackExeHostPlatformException Just DockerStackExeImage -> do progName <- liftIO getProgName return (FP.takeBaseName progName, args, [], []) Just (DockerStackExePath path) -> do exePath <- liftIO $ canonicalizePath (toFilePath path) cmdArgs args exePath Just DockerStackExeDownload -> exeDownload args Nothing | configPlatform config == dockerContainerPlatform -> do (exePath,exeTimestamp,misCompatible) <- liftIO $ do exePath <- liftIO getExecutablePath exeTimestamp <- resolveFile' exePath >>= getModificationTime isKnown <- liftIO $ getDockerImageExe config (iiId imageInfo) exePath exeTimestamp return (exePath, exeTimestamp, isKnown) case misCompatible of Just True -> cmdArgs args exePath Just False -> exeDownload args Nothing -> do e <- try $ sinkProcessStderrStdout Nothing envOverride "docker" [ "run" , "-v" , exePath ++ ":" ++ "/tmp/stack" , iiId imageInfo , "/tmp/stack" , "--version"] sinkNull sinkNull let compatible = case e of Left (ProcessExitedUnsuccessfully _ _) -> False Right _ -> True liftIO $ setDockerImageExe config (iiId imageInfo) exePath exeTimestamp compatible if compatible then cmdArgs args exePath else exeDownload args Nothing -> exeDownload args exeDownload args = do exePath <- ensureDockerStackExe dockerContainerPlatform cmdArgs args (toFilePath exePath) cmdArgs args exePath = do let mountPath = hostBinDir FP. FP.takeBaseName exePath return (mountPath, args, [], [Mount exePath mountPath]) -- | If Docker is enabled, re-runs the OS command returned by the second argument in a -- Docker container. Otherwise, runs the inner action. -- -- This takes an optional release action just like `reexecWithOptionalContainer`. execWithOptionalContainer :: M env m => Maybe (Path Abs Dir) -> GetCmdArgs env m -> Maybe (m ()) -> IO () -> Maybe (m ()) -> Maybe (m ()) -> m () execWithOptionalContainer mprojectRoot getCmdArgs mbefore inner mafter mrelease = do config <- asks getConfig inContainer <- getInContainer isReExec <- asks getReExec if | inContainer && not isReExec && (isJust mbefore || isJust mafter) -> throwM OnlyOnHostException | inContainer -> liftIO (do inner exitSuccess) | not (dockerEnable (configDocker config)) -> do fromMaybeAction mbefore liftIO inner fromMaybeAction mafter liftIO exitSuccess | otherwise -> do fromMaybeAction mrelease runContainerAndExit getCmdArgs mprojectRoot (fromMaybeAction mbefore) (fromMaybeAction mafter) where fromMaybeAction Nothing = return () fromMaybeAction (Just hook) = hook -- | Error if running in a container. preventInContainer :: (MonadIO m,MonadThrow m) => m () -> m () preventInContainer inner = do inContainer <- getInContainer if inContainer then throwM OnlyOnHostException else inner -- | Run a command in a new Docker container, then exit the process. runContainerAndExit :: M env m => GetCmdArgs env m -> Maybe (Path Abs Dir) -- ^ Project root (maybe) -> m () -- ^ Action to run before -> m () -- ^ Action to run after -> m () runContainerAndExit getCmdArgs mprojectRoot before after = do config <- asks getConfig let docker = configDocker config envOverride <- getEnvOverride (configPlatform config) checkDockerVersion envOverride docker (env,isStdinTerminal,isStderrTerminal,homeDir) <- liftIO $ (,,,) <$> getEnvironment <*> hIsTerminalDevice stdin <*> hIsTerminalDevice stderr <*> (parseAbsDir =<< getHomeDirectory) isStdoutTerminal <- asks getTerminal let dockerHost = lookup "DOCKER_HOST" env dockerCertPath = lookup "DOCKER_CERT_PATH" env bamboo = lookup "bamboo_buildKey" env jenkins = lookup "JENKINS_HOME" env msshAuthSock = lookup "SSH_AUTH_SOCK" env muserEnv = lookup "USER" env isRemoteDocker = maybe False (isPrefixOf "tcp://") dockerHost image = dockerImage docker when (isRemoteDocker && maybe False (isInfixOf "boot2docker") dockerCertPath) ($logWarn "Warning: Using boot2docker is NOT supported, and not likely to perform well.") maybeImageInfo <- inspect envOverride image imageInfo@Inspect{..} <- case maybeImageInfo of Just ii -> return ii Nothing | dockerAutoPull docker -> do pullImage envOverride docker image mii2 <- inspect envOverride image case mii2 of Just ii2 -> return ii2 Nothing -> throwM (InspectFailedException image) | otherwise -> throwM (NotPulledException image) sandboxDir <- projectDockerSandboxDir projectRoot let ImageConfig {..} = iiConfig imageEnvVars = map (break (== '=')) icEnv platformVariant = BS.unpack $ Hash.digestToHexByteString $ hashRepoName image stackRoot = configStackRoot config sandboxHomeDir = sandboxDir homeDirName isTerm = not (dockerDetach docker) && isStdinTerminal && isStdoutTerminal && isStderrTerminal keepStdinOpen = not (dockerDetach docker) && -- Workaround for https://github.com/docker/docker/issues/12319 -- This is fixed in Docker 1.9.1, but will leave the workaround -- in place for now, for users who haven't upgraded yet. (isTerm || (isNothing bamboo && isNothing jenkins)) newPathEnv <- augmentPath [ hostBinDir , toFilePathNoTrailingSep $ sandboxHomeDir $(mkRelDir ".local/bin")] (T.pack <$> lookupImageEnv "PATH" imageEnvVars) (cmnd,args,envVars,extraMount) <- getCmdArgs docker envOverride imageInfo isRemoteDocker pwd <- getCurrentDir liftIO (do updateDockerImageLastUsed config iiId (toFilePath projectRoot) mapM_ (ensureDir) [sandboxHomeDir, stackRoot]) -- Since $HOME is now mounted in the same place in the container we can -- just symlink $HOME/.ssh to the right place for the stack docker user let sshDir = homeDir sshRelDir sshDirExists <- doesDirExist sshDir sshSandboxDirExists <- liftIO (Files.fileExist (toFilePathNoTrailingSep (sandboxHomeDir sshRelDir))) when (sshDirExists && not sshSandboxDirExists) (liftIO (Files.createSymbolicLink (toFilePathNoTrailingSep sshDir) (toFilePathNoTrailingSep (sandboxHomeDir sshRelDir)))) containerID <- (trim . decodeUtf8) <$> readDockerProcess envOverride (concat [["create" ,"--net=host" ,"-e",inContainerEnvVar ++ "=1" ,"-e",stackRootEnvVar ++ "=" ++ toFilePathNoTrailingSep stackRoot ,"-e",platformVariantEnvVar ++ "=dk" ++ platformVariant ,"-e","HOME=" ++ toFilePathNoTrailingSep sandboxHomeDir ,"-e","PATH=" ++ T.unpack newPathEnv ,"-e","PWD=" ++ toFilePathNoTrailingSep pwd ,"-v",toFilePathNoTrailingSep homeDir ++ ":" ++ toFilePathNoTrailingSep homeDir ,"-v",toFilePathNoTrailingSep stackRoot ++ ":" ++ toFilePathNoTrailingSep stackRoot ,"-v",toFilePathNoTrailingSep projectRoot ++ ":" ++ toFilePathNoTrailingSep projectRoot ,"-v",toFilePathNoTrailingSep sandboxHomeDir ++ ":" ++ toFilePathNoTrailingSep sandboxHomeDir ,"-w",toFilePathNoTrailingSep pwd] ,case muserEnv of Nothing -> [] Just userEnv -> ["-e","USER=" ++ userEnv] ,case msshAuthSock of Nothing -> [] Just sshAuthSock -> ["-e","SSH_AUTH_SOCK=" ++ sshAuthSock ,"-v",sshAuthSock ++ ":" ++ sshAuthSock] -- Disable the deprecated entrypoint in FP Complete-generated images ,["--entrypoint=/usr/bin/env" | isJust (lookupImageEnv oldSandboxIdEnvVar imageEnvVars) && (icEntrypoint == ["/usr/local/sbin/docker-entrypoint"] || icEntrypoint == ["/root/entrypoint.sh"])] ,concatMap (\(k,v) -> ["-e", k ++ "=" ++ v]) envVars ,concatMap mountArg (extraMount ++ dockerMount docker) ,concatMap (\nv -> ["-e", nv]) (dockerEnv docker) ,case dockerContainerName docker of Just name -> ["--name=" ++ name] Nothing -> [] ,["-t" | isTerm] ,["-i" | keepStdinOpen] ,dockerRunArgs docker ,[image] ,[cmnd] ,args]) before #ifndef WINDOWS runInBase <- liftBaseWith $ \run -> return (void . run) oldHandlers <- forM [sigINT,sigABRT,sigHUP,sigPIPE,sigTERM,sigUSR1,sigUSR2] $ \sig -> do let sigHandler = runInBase $ do readProcessNull Nothing envOverride "docker" ["kill","--signal=" ++ show sig,containerID] when (sig `elem` [sigTERM,sigABRT]) $ do -- Give the container 30 seconds to exit gracefully, then send a sigKILL to force it liftIO $ threadDelay 30000000 readProcessNull Nothing envOverride "docker" ["kill",containerID] oldHandler <- liftIO $ installHandler sig (Catch sigHandler) Nothing return (sig, oldHandler) #endif let cmd = Cmd Nothing "docker" envOverride (concat [["start"] ,["-a" | not (dockerDetach docker)] ,["-i" | keepStdinOpen] ,[containerID]]) e <- finally (try $ callProcess' (\cp -> cp { delegate_ctlc = False }) cmd) (do unless (dockerPersist docker || dockerDetach docker) $ catch (readProcessNull Nothing envOverride "docker" ["rm","-f",containerID]) (\(_::ReadProcessException) -> return ()) #ifndef WINDOWS forM_ oldHandlers $ \(sig,oldHandler) -> liftIO $ installHandler sig oldHandler Nothing #endif ) case e of Left (ProcessExitedUnsuccessfully _ ec) -> liftIO (exitWith ec) Right () -> do after liftIO exitSuccess where -- This is using a hash of the Docker repository (without tag or digest) to ensure -- binaries/libraries aren't shared between Docker and host (or incompatible Docker images) hashRepoName :: String -> Hash.Digest Hash.MD5 hashRepoName = Hash.hash . BS.pack . takeWhile (\c -> c /= ':' && c /= '@') lookupImageEnv name vars = case lookup name vars of Just ('=':val) -> Just val _ -> Nothing mountArg (Mount host container) = ["-v",host ++ ":" ++ container] projectRoot = fromMaybeProjectRoot mprojectRoot sshRelDir = $(mkRelDir ".ssh/") -- | Clean-up old docker images and containers. cleanup :: M env m => CleanupOpts -> m () cleanup opts = do config <- asks getConfig let docker = configDocker config envOverride <- getEnvOverride (configPlatform config) checkDockerVersion envOverride docker let runDocker = readDockerProcess envOverride imagesOut <- runDocker ["images","--no-trunc","-f","dangling=false"] danglingImagesOut <- runDocker ["images","--no-trunc","-f","dangling=true"] runningContainersOut <- runDocker ["ps","-a","--no-trunc","-f","status=running"] restartingContainersOut <- runDocker ["ps","-a","--no-trunc","-f","status=restarting"] exitedContainersOut <- runDocker ["ps","-a","--no-trunc","-f","status=exited"] pausedContainersOut <- runDocker ["ps","-a","--no-trunc","-f","status=paused"] let imageRepos = parseImagesOut imagesOut danglingImageHashes = Map.keys (parseImagesOut danglingImagesOut) runningContainers = parseContainersOut runningContainersOut ++ parseContainersOut restartingContainersOut stoppedContainers = parseContainersOut exitedContainersOut ++ parseContainersOut pausedContainersOut inspectMap <- inspects envOverride (Map.keys imageRepos ++ danglingImageHashes ++ map fst stoppedContainers ++ map fst runningContainers) (imagesLastUsed,curTime) <- liftIO ((,) <$> getDockerImagesLastUsed config <*> getZonedTime) let planWriter = buildPlan curTime imagesLastUsed imageRepos danglingImageHashes stoppedContainers runningContainers inspectMap plan = toLazyByteString (execWriter planWriter) plan' <- case dcAction opts of CleanupInteractive -> liftIO (editByteString (intercalate "-" [stackProgName ,dockerCmdName ,dockerCleanupCmdName ,"plan"]) plan) CleanupImmediate -> return plan CleanupDryRun -> do liftIO (LBS.hPut stdout plan) return LBS.empty mapM_ (performPlanLine envOverride) (reverse (filter filterPlanLine (lines (LBS.unpack plan')))) allImageHashesOut <- runDocker ["images","-aq","--no-trunc"] liftIO (pruneDockerImagesLastUsed config (lines (decodeUtf8 allImageHashesOut))) where filterPlanLine line = case line of c:_ | isSpace c -> False _ -> True performPlanLine envOverride line = case filter (not . null) (words (takeWhile (/= '#') line)) of [] -> return () (c:_):t:v:_ -> do args <- if | toUpper c == 'R' && t == imageStr -> do $logInfo (concatT ["Removing image: '",v,"'"]) return ["rmi",v] | toUpper c == 'R' && t == containerStr -> do $logInfo (concatT ["Removing container: '",v,"'"]) return ["rm","-f",v] | otherwise -> throwM (InvalidCleanupCommandException line) e <- try (readDockerProcess envOverride args) case e of Left ex@ReadProcessException{} -> $logError (concatT ["Could not remove: '",v,"': ", show ex]) Left e' -> throwM e' Right _ -> return () _ -> throwM (InvalidCleanupCommandException line) parseImagesOut = Map.fromListWith (++) . map parseImageRepo . drop 1 . lines . decodeUtf8 where parseImageRepo :: String -> (String, [String]) parseImageRepo line = case words line of repo:tag:hash:_ | repo == "" -> (hash,[]) | tag == "" -> (hash,[repo]) | otherwise -> (hash,[repo ++ ":" ++ tag]) _ -> throw (InvalidImagesOutputException line) parseContainersOut = map parseContainer . drop 1 . lines . decodeUtf8 where parseContainer line = case words line of hash:image:rest -> (hash,(image,last rest)) _ -> throw (InvalidPSOutputException line) buildPlan curTime imagesLastUsed imageRepos danglingImageHashes stoppedContainers runningContainers inspectMap = do case dcAction opts of CleanupInteractive -> do buildStrLn (concat ["# STACK DOCKER CLEANUP PLAN" ,"\n#" ,"\n# When you leave the editor, the lines in this plan will be processed." ,"\n#" ,"\n# Lines that begin with 'R' denote an image or container that will be." ,"\n# removed. You may change the first character to/from 'R' to remove/keep" ,"\n# and image or container that would otherwise be kept/removed." ,"\n#" ,"\n# To cancel the cleanup, delete all lines in this file." ,"\n#" ,"\n# By default, the following images/containers will be removed:" ,"\n#"]) buildDefault dcRemoveKnownImagesLastUsedDaysAgo "Known images last used" buildDefault dcRemoveUnknownImagesCreatedDaysAgo "Unknown images created" buildDefault dcRemoveDanglingImagesCreatedDaysAgo "Dangling images created" buildDefault dcRemoveStoppedContainersCreatedDaysAgo "Stopped containers created" buildDefault dcRemoveRunningContainersCreatedDaysAgo "Running containers created" buildStrLn (concat ["#" ,"\n# The default plan can be adjusted using command-line arguments." ,"\n# Run '" ++ unwords [stackProgName, dockerCmdName, dockerCleanupCmdName] ++ " --help' for details." ,"\n#"]) _ -> buildStrLn (unlines ["# Lines that begin with 'R' denote an image or container that will be." ,"# removed."]) buildSection "KNOWN IMAGES (pulled/used by stack)" imagesLastUsed buildKnownImage buildSection "UNKNOWN IMAGES (not managed by stack)" (sortCreated (Map.toList (foldl' (\m (h,_) -> Map.delete h m) imageRepos imagesLastUsed))) buildUnknownImage buildSection "DANGLING IMAGES (no named references and not depended on by other images)" (sortCreated (map (,()) danglingImageHashes)) buildDanglingImage buildSection "STOPPED CONTAINERS" (sortCreated stoppedContainers) (buildContainer (dcRemoveStoppedContainersCreatedDaysAgo opts)) buildSection "RUNNING CONTAINERS" (sortCreated runningContainers) (buildContainer (dcRemoveRunningContainersCreatedDaysAgo opts)) where buildDefault accessor description = case accessor opts of Just days -> buildStrLn ("# - " ++ description ++ " at least " ++ showDays days ++ ".") Nothing -> return () sortCreated = sortWith (\(_,_,x) -> Down x) . mapMaybe (\(h,r) -> case Map.lookup h inspectMap of Nothing -> Nothing Just ii -> Just (h,r,iiCreated ii)) buildSection sectionHead items itemBuilder = do let (anyWrote,b) = runWriter (forM items itemBuilder) when (or anyWrote) $ do buildSectionHead sectionHead tell b buildKnownImage (imageHash,lastUsedProjects) = case Map.lookup imageHash imageRepos of Just repos@(_:_) -> do case lastUsedProjects of (l,_):_ -> forM_ repos (buildImageTime (dcRemoveKnownImagesLastUsedDaysAgo opts) l) _ -> forM_ repos buildKeepImage forM_ lastUsedProjects buildProject buildInspect imageHash return True _ -> return False buildUnknownImage (hash, repos, created) = case repos of [] -> return False _ -> do forM_ repos (buildImageTime (dcRemoveUnknownImagesCreatedDaysAgo opts) created) buildInspect hash return True buildDanglingImage (hash, (), created) = do buildImageTime (dcRemoveDanglingImagesCreatedDaysAgo opts) created hash buildInspect hash return True buildContainer removeAge (hash,(image,name),created) = do let disp = name ++ " (image: " ++ image ++ ")" buildTime containerStr removeAge created disp buildInspect hash return True buildProject (lastUsedTime, projectPath) = buildInfo ("Last used " ++ showDaysAgo lastUsedTime ++ " in " ++ projectPath) buildInspect hash = case Map.lookup hash inspectMap of Just Inspect{iiCreated,iiVirtualSize} -> buildInfo ("Created " ++ showDaysAgo iiCreated ++ maybe "" (\s -> " (size: " ++ printf "%g" (fromIntegral s / 1024.0 / 1024.0 :: Float) ++ "M)") iiVirtualSize) Nothing -> return () showDays days = case days of 0 -> "today" 1 -> "yesterday" n -> show n ++ " days ago" showDaysAgo oldTime = showDays (daysAgo oldTime) daysAgo oldTime = let ZonedTime (LocalTime today _) zone = curTime LocalTime oldDay _ = utcToLocalTime zone oldTime in diffDays today oldDay buildImageTime = buildTime imageStr buildTime t removeAge time disp = case removeAge of Just d | daysAgo time >= d -> buildStrLn ("R " ++ t ++ " " ++ disp) _ -> buildKeep t disp buildKeep t d = buildStrLn (" " ++ t ++ " " ++ d) buildKeepImage = buildKeep imageStr buildSectionHead s = buildStrLn ("\n#\n# " ++ s ++ "\n#\n") buildInfo = buildStrLn . (" # " ++) buildStrLn l = do buildStr l tell (charUtf8 '\n') buildStr = tell . stringUtf8 imageStr = "image" containerStr = "container" -- | Inspect Docker image or container. inspect :: (MonadIO m,MonadLogger m,MonadBaseControl IO m,MonadCatch m) => EnvOverride -> String -> m (Maybe Inspect) inspect envOverride image = do results <- inspects envOverride [image] case Map.toList results of [] -> return Nothing [(_,i)] -> return (Just i) _ -> throwM (InvalidInspectOutputException "expect a single result") -- | Inspect multiple Docker images and/or containers. inspects :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> [String] -> m (Map String Inspect) inspects _ [] = return Map.empty inspects envOverride images = do maybeInspectOut <- try (readDockerProcess envOverride ("inspect" : images)) case maybeInspectOut of Right inspectOut -> -- filtering with 'isAscii' to workaround @docker inspect@ output containing invalid UTF-8 case eitherDecode (LBS.pack (filter isAscii (decodeUtf8 inspectOut))) of Left msg -> throwM (InvalidInspectOutputException msg) Right results -> return (Map.fromList (map (\r -> (iiId r,r)) results)) Left (ReadProcessException _ _ _ err) | "Error: No such image" `LBS.isPrefixOf` err -> return Map.empty Left e -> throwM e -- | Pull latest version of configured Docker image from registry. pull :: M env m => m () pull = do config <- asks getConfig let docker = configDocker config envOverride <- getEnvOverride (configPlatform config) checkDockerVersion envOverride docker pullImage envOverride docker (dockerImage docker) -- | Pull Docker image from registry. pullImage :: (MonadLogger m,MonadIO m,MonadThrow m,MonadBaseControl IO m) => EnvOverride -> DockerOpts -> String -> m () pullImage envOverride docker image = do $logInfo (concatT ["Pulling image from registry: '",image,"'"]) when (dockerRegistryLogin docker) (do $logInfo "You may need to log in." callProcess $ Cmd Nothing "docker" envOverride (concat [["login"] ,maybe [] (\n -> ["--username=" ++ n]) (dockerRegistryUsername docker) ,maybe [] (\p -> ["--password=" ++ p]) (dockerRegistryPassword docker) ,[takeWhile (/= '/') image]])) e <- try (callProcess (Cmd Nothing "docker" envOverride ["pull",image])) case e of Left (ProcessExitedUnsuccessfully _ _) -> throwM (PullFailedException image) Right () -> return () -- | Check docker version (throws exception if incorrect) checkDockerVersion :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> DockerOpts -> m () checkDockerVersion envOverride docker = do dockerExists <- doesExecutableExist envOverride "docker" unless dockerExists (throwM DockerNotInstalledException) dockerVersionOut <- readDockerProcess envOverride ["--version"] case words (decodeUtf8 dockerVersionOut) of (_:_:v:_) -> case parseVersionFromString (stripVersion v) of Just v' | v' < minimumDockerVersion -> throwM (DockerTooOldException minimumDockerVersion v') | v' `elem` prohibitedDockerVersions -> throwM (DockerVersionProhibitedException prohibitedDockerVersions v') | not (v' `withinRange` dockerRequireDockerVersion docker) -> throwM (BadDockerVersionException (dockerRequireDockerVersion docker) v') | otherwise -> return () _ -> throwM InvalidVersionOutputException _ -> throwM InvalidVersionOutputException where minimumDockerVersion = $(mkVersion "1.6.0") prohibitedDockerVersions = [] stripVersion v = fst $ break (== '-') $ dropWhileEnd (not . isDigit) v -- | Remove the project's Docker sandbox. reset :: (MonadIO m, MonadReader env m, HasConfig env) => Maybe (Path Abs Dir) -> Bool -> m () reset maybeProjectRoot keepHome = do dockerSandboxDir <- projectDockerSandboxDir projectRoot liftIO (removeDirectoryContents dockerSandboxDir [homeDirName | keepHome] []) where projectRoot = fromMaybeProjectRoot maybeProjectRoot -- | The Docker container "entrypoint": special actions performed when first entering -- a container, such as switching the UID/GID to the "outside-Docker" user's. entrypoint :: (MonadIO m, MonadBaseControl IO m, MonadCatch m, MonadLogger m) => Config -> DockerEntrypoint -> m () entrypoint config@Config{..} DockerEntrypoint{..} = modifyMVar_ entrypointMVar $ \alreadyRan -> do -- Only run the entrypoint once unless alreadyRan $ do envOverride <- getEnvOverride configPlatform homeDir <- parseAbsDir =<< liftIO (getEnv "HOME") -- Get the UserEntry for the 'stack' user in the image, if it exists estackUserEntry0 <- liftIO $ tryJust (guard . isDoesNotExistError) $ User.getUserEntryForName stackUserName -- Switch UID/GID if needed, and update user's home directory case deUser of Nothing -> return () Just (DockerUser 0 _ _ _) -> return () Just du -> updateOrCreateStackUser envOverride estackUserEntry0 homeDir du case estackUserEntry0 of Left _ -> return () Right ue -> do -- If the 'stack' user exists in the image, copy any build plans and package indices from -- its original home directory to the host's stack root, to avoid needing to download them origStackHomeDir <- parseAbsDir (User.homeDirectory ue) let origStackRoot = origStackHomeDir $(mkRelDir ("." ++ stackProgName)) buildPlanDirExists <- doesDirExist (buildPlanDir origStackRoot) when buildPlanDirExists $ do (_, buildPlans) <- listDir (buildPlanDir origStackRoot) forM_ buildPlans $ \srcBuildPlan -> do let destBuildPlan = buildPlanDir configStackRoot filename srcBuildPlan exists <- doesFileExist destBuildPlan unless exists $ do ensureDir (parent destBuildPlan) copyFile srcBuildPlan destBuildPlan forM_ configPackageIndices $ \pkgIdx -> do msrcIndex <- flip runReaderT (config{configStackRoot = origStackRoot}) $ do srcIndex <- configPackageIndex (indexName pkgIdx) exists <- doesFileExist srcIndex return $ if exists then Just srcIndex else Nothing case msrcIndex of Nothing -> return () Just srcIndex -> do flip runReaderT config $ do destIndex <- configPackageIndex (indexName pkgIdx) exists <- doesFileExist destIndex unless exists $ do ensureDir (parent destIndex) copyFile srcIndex destIndex return True where updateOrCreateStackUser envOverride estackUserEntry homeDir DockerUser{..} = do case estackUserEntry of Left _ -> do -- If no 'stack' user in image, create one with correct UID/GID and home directory readProcessNull Nothing envOverride "groupadd" ["-o" ,"--gid",show duGid ,stackUserName] readProcessNull Nothing envOverride "useradd" ["-oN" ,"--uid",show duUid ,"--gid",show duGid ,"--home",toFilePathNoTrailingSep homeDir ,stackUserName] Right _ -> do -- If there is already a 'stack' user in the image, adjust its UID/GID and home directory readProcessNull Nothing envOverride "usermod" ["-o" ,"--uid",show duUid ,"--home",toFilePathNoTrailingSep homeDir ,stackUserName] readProcessNull Nothing envOverride "groupmod" ["-o" ,"--gid",show duGid ,stackUserName] forM_ duGroups $ \gid -> do readProcessNull Nothing envOverride "groupadd" ["-o" ,"--gid",show gid ,"group" ++ show gid] -- 'setuid' to the wanted UID and GID liftIO $ do User.setGroupID duGid #ifndef WINDOWS PosixUser.setGroups duGroups #endif User.setUserID duUid _ <- Files.setFileCreationMask duUmask return () stackUserName = "stack"::String -- | MVar used to ensure the Docker entrypoint is performed exactly once entrypointMVar :: MVar Bool {-# NOINLINE entrypointMVar #-} entrypointMVar = unsafePerformIO (newMVar False) -- | Remove the contents of a directory, without removing the directory itself. -- This is used instead of 'FS.removeTree' to clear bind-mounted directories, since -- removing the root of the bind-mount won't work. removeDirectoryContents :: Path Abs Dir -- ^ Directory to remove contents of -> [Path Rel Dir] -- ^ Top-level directory names to exclude from removal -> [Path Rel File] -- ^ Top-level file names to exclude from removal -> IO () removeDirectoryContents path excludeDirs excludeFiles = do isRootDir <- doesDirExist path when isRootDir (do (lsd,lsf) <- listDir path forM_ lsd (\d -> unless (dirname d `elem` excludeDirs) (removeDirRecur d)) forM_ lsf (\f -> unless (filename f `elem` excludeFiles) (removeFile f))) -- | Produce a strict 'S.ByteString' from the stdout of a -- process. Throws a 'ReadProcessException' exception if the -- process fails. Logs process's stderr using @$logError@. readDockerProcess :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> [String] -> m BS.ByteString readDockerProcess envOverride = readProcessStdout Nothing envOverride "docker" -- | Name of home directory within docker sandbox. homeDirName :: Path Rel Dir homeDirName = $(mkRelDir "_home/") -- | Directory where 'stack' executable is bind-mounted in Docker container hostBinDir :: FilePath hostBinDir = "/opt/host/bin" -- | Convenience function to decode ByteString to String. decodeUtf8 :: BS.ByteString -> String decodeUtf8 bs = T.unpack (T.decodeUtf8 bs) -- | Convenience function constructing message for @$log*@. concatT :: [String] -> Text concatT = T.pack . concat -- | Fail with friendly error if project root not set. fromMaybeProjectRoot :: Maybe (Path Abs Dir) -> Path Abs Dir fromMaybeProjectRoot = fromMaybe (throw CannotDetermineProjectRootException) -- | Environment variable that contained the old sandbox ID. -- | Use of this variable is deprecated, and only used to detect old images. oldSandboxIdEnvVar :: String oldSandboxIdEnvVar = "DOCKER_SANDBOX_ID" -- | Command-line argument for "docker" dockerCmdName :: String dockerCmdName = "docker" dockerHelpOptName :: String dockerHelpOptName = dockerCmdName ++ "-help" -- | Command-line argument for @docker pull@. dockerPullCmdName :: String dockerPullCmdName = "pull" -- | Command-line argument for @docker cleanup@. dockerCleanupCmdName :: String dockerCleanupCmdName = "cleanup" -- | Command-line option for @--internal-re-exec-version@. reExecArgName :: String reExecArgName = "internal-re-exec-version" -- | Platform that Docker containers run dockerContainerPlatform :: Platform dockerContainerPlatform = Platform X86_64 Linux -- | Options for 'cleanup'. data CleanupOpts = CleanupOpts { dcAction :: !CleanupAction , dcRemoveKnownImagesLastUsedDaysAgo :: !(Maybe Integer) , dcRemoveUnknownImagesCreatedDaysAgo :: !(Maybe Integer) , dcRemoveDanglingImagesCreatedDaysAgo :: !(Maybe Integer) , dcRemoveStoppedContainersCreatedDaysAgo :: !(Maybe Integer) , dcRemoveRunningContainersCreatedDaysAgo :: !(Maybe Integer) } deriving (Show) -- | Cleanup action. data CleanupAction = CleanupInteractive | CleanupImmediate | CleanupDryRun deriving (Show) -- | Parsed result of @docker inspect@. data Inspect = Inspect {iiConfig :: ImageConfig ,iiCreated :: UTCTime ,iiId :: String ,iiVirtualSize :: Maybe Integer} deriving (Show) -- | Parse @docker inspect@ output. instance FromJSON Inspect where parseJSON v = do o <- parseJSON v Inspect <$> o .: "Config" <*> o .: "Created" <*> o .: "Id" <*> o .:? "VirtualSize" -- | Parsed @Config@ section of @docker inspect@ output. data ImageConfig = ImageConfig {icEnv :: [String] ,icEntrypoint :: [String]} deriving (Show) -- | Parse @Config@ section of @docker inspect@ output. instance FromJSON ImageConfig where parseJSON v = do o <- parseJSON v ImageConfig <$> fmap join (o .:? "Env") .!= [] <*> fmap join (o .:? "Entrypoint") .!= [] -- | Exceptions thrown by Stack.Docker. data StackDockerException = DockerMustBeEnabledException -- ^ Docker must be enabled to use the command. | OnlyOnHostException -- ^ Command must be run on host OS (not in a container). | InspectFailedException String -- ^ @docker inspect@ failed. | NotPulledException String -- ^ Image does not exist. | InvalidCleanupCommandException String -- ^ Input to @docker cleanup@ has invalid command. | InvalidImagesOutputException String -- ^ Invalid output from @docker images@. | InvalidPSOutputException String -- ^ Invalid output from @docker ps@. | InvalidInspectOutputException String -- ^ Invalid output from @docker inspect@. | PullFailedException String -- ^ Could not pull a Docker image. | DockerTooOldException Version Version -- ^ Installed version of @docker@ below minimum version. | DockerVersionProhibitedException [Version] Version -- ^ Installed version of @docker@ is prohibited. | BadDockerVersionException VersionRange Version -- ^ Installed version of @docker@ is out of range specified in config file. | InvalidVersionOutputException -- ^ Invalid output from @docker --version@. | HostStackTooOldException Version (Maybe Version) -- ^ Version of @stack@ on host is too old for version in image. | ContainerStackTooOldException Version Version -- ^ Version of @stack@ in container/image is too old for version on host. | CannotDetermineProjectRootException -- ^ Can't determine the project root (where to put docker sandbox). | DockerNotInstalledException -- ^ @docker --version@ failed. | UnsupportedStackExeHostPlatformException -- ^ Using host stack-exe on unsupported platform. deriving (Typeable) -- | Exception instance for StackDockerException. instance Exception StackDockerException -- | Show instance for StackDockerException. instance Show StackDockerException where show DockerMustBeEnabledException = "Docker must be enabled in your configuration file to use this command." show OnlyOnHostException = "This command must be run on host OS (not in a Docker container)." show (InspectFailedException image) = concat ["'docker inspect' failed for image after pull: ",image,"."] show (NotPulledException image) = concat ["The Docker image referenced by your configuration file" ," has not\nbeen downloaded:\n " ,image ,"\n\nRun '" ,unwords [stackProgName, dockerCmdName, dockerPullCmdName] ,"' to download it, then try again."] show (InvalidCleanupCommandException line) = concat ["Invalid line in cleanup commands: '",line,"'."] show (InvalidImagesOutputException line) = concat ["Invalid 'docker images' output line: '",line,"'."] show (InvalidPSOutputException line) = concat ["Invalid 'docker ps' output line: '",line,"'."] show (InvalidInspectOutputException msg) = concat ["Invalid 'docker inspect' output: ",msg,"."] show (PullFailedException image) = concat ["Could not pull Docker image:\n " ,image ,"\nThere may not be an image on the registry for your resolver's LTS version in\n" ,"your configuration file."] show (DockerTooOldException minVersion haveVersion) = concat ["Minimum docker version '" ,versionString minVersion ,"' is required by " ,stackProgName ," (you have '" ,versionString haveVersion ,"')."] show (DockerVersionProhibitedException prohibitedVersions haveVersion) = concat ["These Docker versions are incompatible with " ,stackProgName ," (you have '" ,versionString haveVersion ,"'): " ,intercalate ", " (map versionString prohibitedVersions) ,"."] show (BadDockerVersionException requiredRange haveVersion) = concat ["The version of 'docker' you are using (" ,show haveVersion ,") is outside the required\n" ,"version range specified in stack.yaml (" ,T.unpack (versionRangeText requiredRange) ,")."] show InvalidVersionOutputException = "Cannot get Docker version (invalid 'docker --version' output)." show (HostStackTooOldException minVersion (Just hostVersion)) = concat ["The host's version of '" ,stackProgName ,"' is too old for this Docker image.\nVersion " ,versionString minVersion ," is required; you have " ,versionString hostVersion ,"."] show (HostStackTooOldException minVersion Nothing) = concat ["The host's version of '" ,stackProgName ,"' is too old.\nVersion " ,versionString minVersion ," is required."] show (ContainerStackTooOldException requiredVersion containerVersion) = concat ["The Docker container's version of '" ,stackProgName ,"' is too old.\nVersion " ,versionString requiredVersion ," is required; the container has " ,versionString containerVersion ,"."] show CannotDetermineProjectRootException = "Cannot determine project root directory for Docker sandbox." show DockerNotInstalledException = "Cannot find 'docker' in PATH. Is Docker installed?" show UnsupportedStackExeHostPlatformException = concat [ "Using host's " , stackProgName , " executable in Docker container is only supported on " , display dockerContainerPlatform , " platform" ] -- | Function to get command and arguments to run in Docker container type GetCmdArgs env m = M env m => DockerOpts -> EnvOverride -> Inspect -> Bool -> m (FilePath,[String],[(String,String)],[Mount]) type M env m = (MonadIO m,MonadReader env m,MonadLogger m,MonadBaseControl IO m,MonadCatch m ,HasConfig env,HasTerminal env,HasReExec env,HasHttpManager env,MonadMask m) stack-1.1.2/src/Stack/Docker/GlobalDB.hs0000644000000000000000000001174712662071422016027 0ustar0000000000000000{-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, OverloadedStrings, GADTs, FlexibleContexts, MultiParamTypeClasses, GeneralizedNewtypeDeriving, RankNTypes, NamedFieldPuns #-} -- | Global sqlite database shared by all projects. -- Warning: this is currently only accessible from __outside__ a Docker container. module Stack.Docker.GlobalDB (updateDockerImageLastUsed ,getDockerImagesLastUsed ,pruneDockerImagesLastUsed ,DockerImageLastUsed ,DockerImageProjectId ,getDockerImageExe ,setDockerImageExe ,DockerImageExeId) where import Control.Exception (IOException,catch,throwIO) import Control.Monad (forM_, when) import Control.Monad.Logger (NoLoggingT) import Control.Monad.Trans.Resource (ResourceT) import Data.List (sortBy, isInfixOf, stripPrefix) import Data.List.Extra (stripSuffix) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) import qualified Data.Text as T import Data.Time.Clock (UTCTime,getCurrentTime) import Database.Persist import Database.Persist.Sqlite import Database.Persist.TH import Path (toFilePath, parent) import Path.IO (ensureDir) import Stack.Types.Config import Stack.Types.Docker share [mkPersist sqlSettings, mkMigrate "migrateTables"] [persistLowerCase| DockerImageProject imageHash String projectPath FilePath lastUsedTime UTCTime DockerImageProjectPathKey imageHash projectPath deriving Show DockerImageExe imageHash String exePath FilePath exeTimestamp UTCTime compatible Bool DockerImageExeUnique imageHash exePath exeTimestamp deriving Show |] -- | Update last used time and project for a Docker image hash. updateDockerImageLastUsed :: Config -> String -> FilePath -> IO () updateDockerImageLastUsed config imageId projectPath = do curTime <- getCurrentTime _ <- withGlobalDB config (upsert (DockerImageProject imageId projectPath curTime) []) return () -- | Get a list of Docker image hashes and when they were last used. getDockerImagesLastUsed :: Config -> IO [DockerImageLastUsed] getDockerImagesLastUsed config = do imageProjects <- withGlobalDB config (selectList [] [Asc DockerImageProjectLastUsedTime]) return (sortBy (flip sortImage) (Map.toDescList (Map.fromListWith (++) (map mapImageProject imageProjects)))) where mapImageProject (Entity _ imageProject) = (dockerImageProjectImageHash imageProject ,[(dockerImageProjectLastUsedTime imageProject ,dockerImageProjectProjectPath imageProject)]) sortImage (_,(a,_):_) (_,(b,_):_) = compare a b sortImage _ _ = EQ -- | Given a list of all existing Docker images, remove any that no longer exist from -- the database. pruneDockerImagesLastUsed :: Config -> [String] -> IO () pruneDockerImagesLastUsed config existingHashes = withGlobalDB config go where go = do l <- selectList [] [] forM_ l (\(Entity k DockerImageProject{dockerImageProjectImageHash = h}) -> when (h `notElem` existingHashes) $ delete k) -- | Get the record of whether an executable is compatible with a Docker image getDockerImageExe :: Config -> String -> FilePath -> UTCTime -> IO (Maybe Bool) getDockerImageExe config imageId exePath exeTimestamp = withGlobalDB config $ do mentity <- getBy (DockerImageExeUnique imageId exePath exeTimestamp) return (fmap (dockerImageExeCompatible . entityVal) mentity) -- | Seet the record of whether an executable is compatible with a Docker image setDockerImageExe :: Config -> String -> FilePath -> UTCTime -> Bool -> IO () setDockerImageExe config imageId exePath exeTimestamp compatible = withGlobalDB config $ do _ <- upsert (DockerImageExe imageId exePath exeTimestamp compatible) [] return () -- | Run an action with the global database. This performs any needed migrations as well. withGlobalDB :: forall a. Config -> SqlPersistT (NoLoggingT (ResourceT IO)) a -> IO a withGlobalDB config action = do let db = dockerDatabasePath (configDocker config) ensureDir (parent db) runSqlite (T.pack (toFilePath db)) (do _ <- runMigrationSilent migrateTables action) `catch` \ex -> do let str = show ex str' = fromMaybe str $ stripPrefix "user error (" $ fromMaybe str $ stripSuffix ")" str if "ErrorReadOnly" `isInfixOf` str then fail $ str' ++ " This likely indicates that your DB file, " ++ toFilePath db ++ ", has incorrect permissions or ownership." else throwIO (ex :: IOException) -- | Date and project path where Docker image hash last used. type DockerImageLastUsed = (String, [(UTCTime, FilePath)]) stack-1.1.2/src/Stack/Dot.hs0000644000000000000000000002601512717707440013741 0ustar0000000000000000{-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} module Stack.Dot (dot ,listDependencies ,DotOpts(..) ,resolveDependencies ,printGraph ,pruneGraph ) where import Control.Applicative import Control.Arrow ((&&&)) import Control.Monad (liftM, void) import Control.Monad.Catch (MonadCatch,MonadMask) import Control.Monad.IO.Class import Control.Monad.Logger (MonadLogger) import Control.Monad.Reader (MonadReader) import Control.Monad.Trans.Unlift (MonadBaseUnlift) import qualified Data.Foldable as F import qualified Data.HashSet as HashSet import Data.Map (Map) import qualified Data.Map as Map import Data.Monoid ((<>)) import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text import qualified Data.Traversable as T import Network.HTTP.Client.Conduit (HasHttpManager) import Prelude -- Fix redundant import warnings import Stack.Build (withLoadPackage) import Stack.Build.Installed (getInstalled, GetInstalledOpts(..)) import Stack.Build.Source import Stack.Build.Target import Stack.Constants import Stack.Package import Stack.Types import Stack.Types.Internal (HasLogLevel) -- | Options record for @stack dot@ data DotOpts = DotOpts { dotIncludeExternal :: Bool -- ^ Include external dependencies , dotIncludeBase :: Bool -- ^ Include dependencies on base , dotDependencyDepth :: Maybe Int -- ^ Limit the depth of dependency resolution to (Just n) or continue until fixpoint , dotPrune :: Set String -- ^ Package names to prune from the graph } -- | Visualize the project's dependencies as a graphviz graph dot :: (HasEnvConfig env ,HasHttpManager env ,HasLogLevel env ,MonadBaseUnlift IO m ,MonadCatch m ,MonadLogger m ,MonadIO m ,MonadMask m ,MonadReader env m ) => DotOpts -> m () dot dotOpts = do localNames <- liftM Map.keysSet getLocalPackageViews resultGraph <- createDependencyGraph dotOpts let pkgsToPrune = if dotIncludeBase dotOpts then dotPrune dotOpts else Set.insert "base" (dotPrune dotOpts) prunedGraph = pruneGraph localNames pkgsToPrune resultGraph printGraph dotOpts localNames prunedGraph -- | Create the dependency graph, the result is a map from a package -- name to a tuple of dependencies and a version if available. This -- function mainly gathers the required arguments for -- @resolveDependencies@. createDependencyGraph :: (HasEnvConfig env ,HasHttpManager env ,HasLogLevel env ,MonadLogger m ,MonadBaseUnlift IO m ,MonadIO m ,MonadMask m ,MonadReader env m) => DotOpts -> m (Map PackageName (Set PackageName, Maybe Version)) createDependencyGraph dotOpts = do (_,_,locals,_,sourceMap) <- loadSourceMap NeedTargets defaultBuildOptsCLI let graph = Map.fromList (localDependencies dotOpts locals) menv <- getMinimalEnvOverride installedMap <- fmap snd . fst4 <$> getInstalled menv (GetInstalledOpts False False) sourceMap withLoadPackage menv (\loader -> do let depLoader = createDepLoader sourceMap installedMap (fmap4 (packageAllDeps &&& (Just . packageVersion)) loader) liftIO $ resolveDependencies (dotDependencyDepth dotOpts) graph depLoader) where -- fmap a function over the result of a function with 3 arguments fmap4 :: Functor f => (r -> r') -> (a -> b -> c -> d -> f r) -> a -> b -> c -> d -> f r' fmap4 f g a b c d = f <$> g a b c d fst4 :: (a,b,c,d) -> a fst4 (x,_,_,_) = x listDependencies :: (HasEnvConfig env ,HasHttpManager env ,HasLogLevel env ,MonadBaseUnlift IO m ,MonadLogger m ,MonadMask m ,MonadIO m ,MonadReader env m ) => Text -> m () listDependencies sep = do let dotOpts = DotOpts True True Nothing Set.empty resultGraph <- createDependencyGraph dotOpts void (Map.traverseWithKey go (snd <$> resultGraph)) where go name v = liftIO (Text.putStrLn $ Text.pack (packageNameString name) <> sep <> maybe "" (Text.pack . show) v) -- | @pruneGraph dontPrune toPrune graph@ prunes all packages in -- @graph@ with a name in @toPrune@ and removes resulting orphans -- unless they are in @dontPrune@ pruneGraph :: (F.Foldable f, F.Foldable g, Eq a) => f PackageName -> g String -> Map PackageName (Set PackageName, a) -> Map PackageName (Set PackageName, a) pruneGraph dontPrune names = pruneUnreachable dontPrune . Map.mapMaybeWithKey (\pkg (pkgDeps,x) -> if show pkg `F.elem` names then Nothing else let filtered = Set.filter (\n -> show n `F.notElem` names) pkgDeps in if Set.null filtered && not (Set.null pkgDeps) then Nothing else Just (filtered,x)) -- | Make sure that all unreachable nodes (orphans) are pruned pruneUnreachable :: (Eq a, F.Foldable f) => f PackageName -> Map PackageName (Set PackageName, a) -> Map PackageName (Set PackageName, a) pruneUnreachable dontPrune = fixpoint prune where fixpoint :: Eq a => (a -> a) -> a -> a fixpoint f v = if f v == v then v else fixpoint f (f v) prune graph' = Map.filterWithKey (\k _ -> reachable k) graph' where reachable k = k `F.elem` dontPrune || k `Set.member` reachables reachables = F.fold (fst <$> graph') -- | Resolve the dependency graph up to (Just depth) or until fixpoint is reached resolveDependencies :: (Applicative m, Monad m) => Maybe Int -> Map PackageName (Set PackageName,Maybe Version) -> (PackageName -> m (Set PackageName, Maybe Version)) -> m (Map PackageName (Set PackageName,Maybe Version)) resolveDependencies (Just 0) graph _ = return graph resolveDependencies limit graph loadPackageDeps = do let values = Set.unions (fst <$> Map.elems graph) keys = Map.keysSet graph next = Set.difference values keys if Set.null next then return graph else do x <- T.traverse (\name -> (name,) <$> loadPackageDeps name) (F.toList next) resolveDependencies (subtract 1 <$> limit) (Map.unionWith unifier graph (Map.fromList x)) loadPackageDeps where unifier (pkgs1,v1) (pkgs2,_) = (Set.union pkgs1 pkgs2, v1) -- | Given a SourceMap and a dependency loader, load the set of dependencies for a package createDepLoader :: Applicative m => Map PackageName PackageSource -> Map PackageName Installed -> (PackageName -> Version -> Map FlagName Bool -> [Text] -> m (Set PackageName,Maybe Version)) -> PackageName -> m (Set PackageName, Maybe Version) createDepLoader sourceMap installed loadPackageDeps pkgName = case Map.lookup pkgName sourceMap of Just (PSLocal lp) -> pure ((packageAllDeps &&& (Just . packageVersion)) (lpPackage lp)) Just (PSUpstream version _ flags ghcOptions _) -> loadPackageDeps pkgName version flags ghcOptions Nothing -> pure (Set.empty, fmap installedVersion (Map.lookup pkgName installed)) -- | Resolve the direct (depth 0) external dependencies of the given local packages localDependencies :: DotOpts -> [LocalPackage] -> [(PackageName,(Set PackageName,Maybe Version))] localDependencies dotOpts locals = map (\lp -> (packageName (lpPackage lp), (deps lp,Just (lpVersion lp)))) locals where deps lp = if dotIncludeExternal dotOpts then Set.delete (lpName lp) (packageAllDeps (lpPackage lp)) else Set.intersection localNames (packageAllDeps (lpPackage lp)) lpName lp = packageName (lpPackage lp) localNames = Set.fromList $ map (packageName . lpPackage) locals lpVersion lp = packageVersion (lpPackage lp) -- | Print a graphviz graph of the edges in the Map and highlight the given local packages printGraph :: (Applicative m, MonadIO m) => DotOpts -> Set PackageName -- ^ all locals -> Map PackageName (Set PackageName, Maybe Version) -> m () printGraph dotOpts locals graph = do liftIO $ Text.putStrLn "strict digraph deps {" printLocalNodes dotOpts filteredLocals printLeaves graph void (Map.traverseWithKey printEdges (fst <$> graph)) liftIO $ Text.putStrLn "}" where filteredLocals = Set.filter (\local -> packageNameString local `Set.notMember` dotPrune dotOpts) locals -- | Print the local nodes with a different style depending on options printLocalNodes :: (F.Foldable t, MonadIO m) => DotOpts -> t PackageName -> m () printLocalNodes dotOpts locals = liftIO $ Text.putStrLn (Text.intercalate "\n" lpNodes) where applyStyle :: Text -> Text applyStyle n = if dotIncludeExternal dotOpts then n <> " [style=dashed];" else n <> " [style=solid];" lpNodes :: [Text] lpNodes = map (applyStyle . nodeName) (F.toList locals) -- | Print nodes without dependencies printLeaves :: MonadIO m => Map PackageName (Set PackageName,Maybe Version) -> m () printLeaves = F.mapM_ printLeaf . Map.keysSet . Map.filter Set.null . fmap fst -- | @printDedges p ps@ prints an edge from p to every ps printEdges :: MonadIO m => PackageName -> Set PackageName -> m () printEdges package deps = F.forM_ deps (printEdge package) -- | Print an edge between the two package names printEdge :: MonadIO m => PackageName -> PackageName -> m () printEdge from to = liftIO $ Text.putStrLn (Text.concat [ nodeName from, " -> ", nodeName to, ";"]) -- | Convert a package name to a graph node name. nodeName :: PackageName -> Text nodeName name = "\"" <> Text.pack (packageNameString name) <> "\"" -- | Print a node with no dependencies printLeaf :: MonadIO m => PackageName -> m () printLeaf package = liftIO . Text.putStrLn . Text.concat $ if isWiredIn package then ["{rank=max; ", nodeName package, " [shape=box]; };"] else ["{rank=max; ", nodeName package, "; };"] -- | Check if the package is wired in (shipped with) ghc isWiredIn :: PackageName -> Bool isWiredIn = (`HashSet.member` wiredInPackages) stack-1.1.2/src/Stack/Exec.hs0000644000000000000000000000502412717707440014074 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} #if __GLASGOW_HASKELL__ >= 800 {-# OPTIONS_GHC -Wno-redundant-constraints #-} #endif -- | Execute commands within the properly configured Stack -- environment. module Stack.Exec where import Control.Monad.Reader import Control.Monad.Logger import Control.Monad.Trans.Control (MonadBaseControl) import Stack.Types import System.Process.Log import Control.Exception.Lifted import Data.Streaming.Process (ProcessExitedUnsuccessfully(..)) import System.Exit import System.Process.Run (callProcess, Cmd(..)) #ifdef WINDOWS import System.Process.Read (EnvOverride) #else import System.Posix.Process (executeFile) import System.Process.Read (EnvOverride, envHelper, preProcess) #endif -- | Default @EnvSettings@ which includes locals and GHC_PACKAGE_PATH defaultEnvSettings :: EnvSettings defaultEnvSettings = EnvSettings { esIncludeLocals = True , esIncludeGhcPackagePath = True , esStackExe = True , esLocaleUtf8 = False } -- | Environment settings which do not embellish the environment plainEnvSettings :: EnvSettings plainEnvSettings = EnvSettings { esIncludeLocals = False , esIncludeGhcPackagePath = False , esStackExe = False , esLocaleUtf8 = False } -- | Execute a process within the Stack configured environment. -- -- Execution will not return, because either: -- -- 1) On non-windows, execution is taken over by execv of the -- sub-process. This allows signals to be propagated (#527) -- -- 2) On windows, an 'ExitCode' exception will be thrown. exec :: (MonadIO m, MonadLogger m, MonadBaseControl IO m) => EnvOverride -> String -> [String] -> m b #ifdef WINDOWS exec = execSpawn #else exec menv cmd0 args = do $logProcessRun cmd0 args cmd <- preProcess Nothing menv cmd0 liftIO $ executeFile cmd True args (envHelper menv) #endif -- | Like 'exec', but does not use 'execv' on non-windows. This way, there -- is a sub-process, which is helpful in some cases (#1306) -- -- This function only exits by throwing 'ExitCode'. execSpawn :: (MonadIO m, MonadLogger m, MonadBaseControl IO m) => EnvOverride -> String -> [String] -> m b execSpawn menv cmd0 args = do $logProcessRun cmd0 args e <- try (callProcess (Cmd Nothing cmd0 menv args)) liftIO $ case e of Left (ProcessExitedUnsuccessfully _ ec) -> exitWith ec Right () -> exitSuccess stack-1.1.2/src/Stack/Fetch.hs0000644000000000000000000006331312717707440014246 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE ViewPatterns #-} -- | Functionality for downloading packages securely for cabal's usage. module Stack.Fetch ( unpackPackages , unpackPackageIdents , fetchPackages , resolvePackages , resolvePackagesAllowMissing , ResolvedPackage (..) , withCabalFiles , withCabalLoader ) where import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Check as Tar import qualified Codec.Archive.Tar.Entry as Tar import Codec.Compression.GZip (decompress) import Control.Applicative import Control.Concurrent.Async (Concurrently (..)) import Control.Concurrent.MVar.Lifted (modifyMVar, newMVar) import Control.Concurrent.STM (TVar, atomically, modifyTVar, newTVarIO, readTVar, readTVarIO, writeTVar) import Control.Exception (assert) import Control.Exception.Enclosed (tryIO) import Control.Monad (join, liftM, unless, void, when) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (asks, runReaderT) import Control.Monad.Trans.Control import Control.Monad.Trans.Unlift (MonadBaseUnlift, askRunBase) import "cryptohash" Crypto.Hash (SHA512 (..)) import Data.ByteString (ByteString) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.Either (partitionEithers) import qualified Data.Foldable as F import Data.Function (fix) import qualified Data.Git as Git import qualified Data.Git.Ref as Git import qualified Data.Git.Storage as Git import qualified Data.Git.Storage.Object as Git import Data.List (intercalate) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (maybeToList, catMaybes) import Data.Monoid import Data.Set (Set) import qualified Data.Set as Set import Data.String (fromString) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) import Data.Typeable (Typeable) import Data.Word (Word64) import Network.HTTP.Download import Path import Path.IO import Prelude -- Fix AMP warning import Stack.GhcPkg import Stack.PackageIndex import Stack.Types import qualified System.Directory as D import System.FilePath ((<.>)) import qualified System.FilePath as FP import System.IO (IOMode (ReadMode), SeekMode (AbsoluteSeek), hSeek, withBinaryFile, openBinaryFile, hClose) import System.PosixCompat (setFileMode) import Text.EditDistance as ED type PackageCaches = Map PackageIdentifier (PackageIndex, PackageCache) data FetchException = Couldn'tReadIndexTarball FilePath Tar.FormatError | Couldn'tReadPackageTarball FilePath SomeException | UnpackDirectoryAlreadyExists (Set FilePath) | CouldNotParsePackageSelectors [String] | UnknownPackageNames (Set PackageName) | UnknownPackageIdentifiers (Set PackageIdentifier) String deriving Typeable instance Exception FetchException instance Show FetchException where show (Couldn'tReadIndexTarball fp err) = concat [ "There was an error reading the index tarball " , fp , ": " , show err ] show (Couldn'tReadPackageTarball fp err) = concat [ "There was an error reading the package tarball " , fp , ": " , show err ] show (UnpackDirectoryAlreadyExists dirs) = unlines $ "Unable to unpack due to already present directories:" : map (" " ++) (Set.toList dirs) show (CouldNotParsePackageSelectors strs) = "The following package selectors are not valid package names or identifiers: " ++ intercalate ", " strs show (UnknownPackageNames names) = "The following packages were not found in your indices: " ++ intercalate ", " (map packageNameString $ Set.toList names) show (UnknownPackageIdentifiers idents suggestions) = "The following package identifiers were not found in your indices: " ++ intercalate ", " (map packageIdentifierString $ Set.toList idents) ++ (if null suggestions then "" else "\n" ++ suggestions) -- | Fetch packages into the cache without unpacking fetchPackages :: (MonadIO m, MonadBaseControl IO m, MonadReader env m, HasHttpManager env, HasConfig env, MonadMask m, MonadLogger m) => EnvOverride -> Set PackageIdentifier -> m () fetchPackages menv idents' = do resolved <- resolvePackages menv idents Set.empty ToFetchResult toFetch alreadyUnpacked <- getToFetch Nothing resolved assert (Map.null alreadyUnpacked) (return ()) nowUnpacked <- fetchPackages' Nothing toFetch assert (Map.null nowUnpacked) (return ()) where -- Since we're just fetching tarballs and not unpacking cabal files, we can -- always provide a Nothing Git SHA idents = Map.fromList $ map (, Nothing) $ Set.toList idents' -- | Intended to work for the command line command. unpackPackages :: (MonadIO m, MonadBaseControl IO m, MonadReader env m, HasHttpManager env, HasConfig env, MonadMask m, MonadLogger m) => EnvOverride -> FilePath -- ^ destination -> [String] -- ^ names or identifiers -> m () unpackPackages menv dest input = do dest' <- resolveDir' dest (names, idents) <- case partitionEithers $ map parse input of ([], x) -> return $ partitionEithers x (errs, _) -> throwM $ CouldNotParsePackageSelectors errs resolved <- resolvePackages menv (Map.fromList $ map (, Nothing) idents) (Set.fromList names) ToFetchResult toFetch alreadyUnpacked <- getToFetch (Just dest') resolved unless (Map.null alreadyUnpacked) $ throwM $ UnpackDirectoryAlreadyExists $ Set.fromList $ map toFilePath $ Map.elems alreadyUnpacked unpacked <- fetchPackages' Nothing toFetch F.forM_ (Map.toList unpacked) $ \(ident, dest'') -> $logInfo $ T.pack $ concat [ "Unpacked " , packageIdentifierString ident , " to " , toFilePath dest'' ] where -- Possible future enhancement: parse names as name + version range parse s = case parsePackageNameFromString s of Right x -> Right $ Left x Left _ -> case parsePackageIdentifierFromString s of Left _ -> Left s Right x -> Right $ Right x -- | Ensure that all of the given package idents are unpacked into the build -- unpack directory, and return the paths to all of the subdirectories. unpackPackageIdents :: (MonadBaseControl IO m, MonadIO m, MonadReader env m, HasHttpManager env, HasConfig env, MonadMask m, MonadLogger m) => EnvOverride -> Path Abs Dir -- ^ unpack directory -> Maybe (Path Rel Dir) -- ^ the dist rename directory, see: https://github.com/fpco/stack/issues/157 -> Map PackageIdentifier (Maybe GitSHA1) -> m (Map PackageIdentifier (Path Abs Dir)) unpackPackageIdents menv unpackDir mdistDir idents = do resolved <- resolvePackages menv idents Set.empty ToFetchResult toFetch alreadyUnpacked <- getToFetch (Just unpackDir) resolved nowUnpacked <- fetchPackages' mdistDir toFetch return $ alreadyUnpacked <> nowUnpacked data ResolvedPackage = ResolvedPackage { rpCache :: !PackageCache , rpIndex :: !PackageIndex , rpGitSHA1 :: !(Maybe GitSHA1) } -- | Resolve a set of package names and identifiers into @FetchPackage@ values. resolvePackages :: (MonadIO m, MonadReader env m, HasHttpManager env, HasConfig env, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> Map PackageIdentifier (Maybe GitSHA1) -> Set PackageName -> m (Map PackageIdentifier ResolvedPackage) resolvePackages menv idents0 names0 = do eres <- go case eres of Left _ -> do updateAllIndices menv go >>= either throwM return Right x -> return x where go = r <$> resolvePackagesAllowMissing idents0 names0 r (missingNames, missingIdents, idents) | not $ Set.null missingNames = Left $ UnknownPackageNames missingNames | not $ Set.null missingIdents = Left $ UnknownPackageIdentifiers missingIdents "" | otherwise = Right idents resolvePackagesAllowMissing :: (MonadIO m, MonadReader env m, HasHttpManager env, HasConfig env, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => Map PackageIdentifier (Maybe GitSHA1) -> Set PackageName -> m (Set PackageName, Set PackageIdentifier, Map PackageIdentifier ResolvedPackage) resolvePackagesAllowMissing idents0 names0 = do caches <- getPackageCaches let versions = Map.fromListWith max $ map toTuple $ Map.keys caches (missingNames, idents1) = partitionEithers $ map (\name -> maybe (Left name ) (Right . PackageIdentifier name) (Map.lookup name versions)) (Set.toList names0) (missingIdents, resolved) = partitionEithers $ map (goIdent caches) $ Map.toList $ idents0 <> Map.fromList (map (, Nothing) idents1) return (Set.fromList missingNames, Set.fromList missingIdents, Map.fromList resolved) where goIdent caches (ident, mgitsha) = case Map.lookup ident caches of Nothing -> Left ident Just (index, cache) -> Right (ident, ResolvedPackage { rpCache = cache , rpIndex = index , rpGitSHA1 = mgitsha }) data ToFetch = ToFetch { tfTarball :: !(Path Abs File) , tfDestDir :: !(Maybe (Path Abs Dir)) , tfUrl :: !T.Text , tfSize :: !(Maybe Word64) , tfSHA512 :: !(Maybe ByteString) , tfCabal :: !ByteString -- ^ Contents of the .cabal file } data ToFetchResult = ToFetchResult { tfrToFetch :: !(Map PackageIdentifier ToFetch) , tfrAlreadyUnpacked :: !(Map PackageIdentifier (Path Abs Dir)) } -- | Add the cabal files to a list of idents with their caches. withCabalFiles :: (MonadMask m, MonadIO m, MonadLogger m, MonadReader env m, HasConfig env) => IndexName -> [(PackageIdentifier, PackageCache, Maybe GitSHA1, a)] -> (PackageIdentifier -> a -> ByteString -> IO b) -> m [b] withCabalFiles name pkgs f = do indexPath <- configPackageIndex name mgitRepo <- configPackageIndexRepo name bracket (liftIO $ openBinaryFile (toFilePath indexPath) ReadMode) (liftIO . hClose) $ \h -> let inner mgit = mapM (goPkg h mgit) pkgs in case mgitRepo of Nothing -> inner Nothing Just repo -> bracket (liftIO $ Git.openRepo $ fromString $ toFilePath repo FP. ".git") (liftIO . Git.closeRepo) (inner . Just) where goPkg h (Just git) (ident, pc, Just (GitSHA1 sha), tf) = do let ref = Git.fromHex sha mobj <- liftIO $ tryIO $ Git.getObject git ref True case mobj of Right (Just (Git.ObjBlob (Git.Blob bs))) -> liftIO $ f ident tf (L.toStrict bs) -- fallback when the appropriate SHA isn't found e -> do $logWarn $ mconcat [ "Did not find .cabal file for " , T.pack $ packageIdentifierString ident , " with Git SHA of " , decodeUtf8 sha , "\n" , T.pack $ show e ] goPkg h Nothing (ident, pc, Nothing, tf) goPkg h _mgit (ident, pc, _mgitsha, tf) = liftIO $ do hSeek h AbsoluteSeek $ fromIntegral $ pcOffset pc cabalBS <- S.hGet h $ fromIntegral $ pcSize pc f ident tf cabalBS -- | Provide a function which will load up a cabal @ByteString@ from the -- package indices. withCabalLoader :: (MonadIO m, MonadReader env m, HasConfig env, MonadLogger m, HasHttpManager env, MonadBaseUnlift IO m, MonadMask m) => EnvOverride -> ((PackageIdentifier -> IO ByteString) -> m a) -> m a withCabalLoader menv inner = do env <- ask -- Want to try updating the index once during a single run for missing -- package identifiers. We also want to ensure we only update once at a -- time -- -- TODO: probably makes sense to move this concern into getPackageCaches updateRef <- liftIO $ newMVar True loadCaches <- getPackageCachesIO runInBase <- liftBaseWith $ \run -> return (void . run) unlift <- askRunBase -- TODO in the future, keep all of the necessary @Handle@s open let doLookup :: PackageIdentifier -> IO ByteString doLookup ident = do caches <- loadCaches eres <- unlift $ lookupPackageIdentifierExact ident env caches case eres of Just bs -> return bs -- Update the cache and try again Nothing -> do let fuzzy = fuzzyLookupCandidates ident caches suggestions = case fuzzy of Nothing -> case typoCorrectionCandidates ident caches of Nothing -> "" Just cs -> "Perhaps you meant " <> orSeparated cs <> "?" Just cs -> "Possible candidates: " <> commaSeparated (NE.map packageIdentifierString cs) <> "." join $ modifyMVar updateRef $ \toUpdate -> if toUpdate then do runInBase $ do $logInfo $ T.concat [ "Didn't see " , T.pack $ packageIdentifierString ident , " in your package indices.\n" , "Updating and trying again." ] updateAllIndices menv _ <- getPackageCaches return () return (False, doLookup ident) else return (toUpdate, throwM $ UnknownPackageIdentifiers (Set.singleton ident) suggestions) inner doLookup lookupPackageIdentifierExact :: (MonadMask m, MonadIO m, MonadLogger m, HasConfig env) => PackageIdentifier -> env -> PackageCaches -> m (Maybe ByteString) lookupPackageIdentifierExact ident env caches = case Map.lookup ident caches of Nothing -> return Nothing Just (index, cache) -> do [bs] <- flip runReaderT env $ withCabalFiles (indexName index) [(ident, cache, Nothing, ())] $ \_ _ bs -> return bs return $ Just bs -- | Given package identifier and package caches, return list of packages -- with the same name and the same two first version number components found -- in the caches. fuzzyLookupCandidates :: PackageIdentifier -> PackageCaches -> Maybe (NonEmpty PackageIdentifier) fuzzyLookupCandidates (PackageIdentifier name ver) caches = let (_, zero, bigger) = Map.splitLookup zeroIdent caches zeroIdent = PackageIdentifier name $(mkVersion "0.0") sameName (PackageIdentifier n _) = n == name sameMajor (PackageIdentifier _ v) = toMajorVersion v == toMajorVersion ver in NE.nonEmpty . filter sameMajor $ maybe [] (pure . const zeroIdent) zero <> takeWhile sameName (Map.keys bigger) -- | Try to come up with typo corrections for given package identifier using -- package caches. This should be called before giving up, i.e. when -- 'fuzzyLookupCandidates' cannot return anything. typoCorrectionCandidates :: PackageIdentifier -> PackageCaches -> Maybe (NonEmpty String) typoCorrectionCandidates ident = let getName = packageNameString . packageIdentifierName name = getName ident in NE.nonEmpty . Map.keys . Map.filterWithKey (const . (== 1) . damerauLevenshtein name) . Map.mapKeys getName -- | Figure out where to fetch from. getToFetch :: (MonadMask m, MonadLogger m, MonadIO m, MonadReader env m, HasConfig env) => Maybe (Path Abs Dir) -- ^ directory to unpack into, @Nothing@ means no unpack -> Map PackageIdentifier ResolvedPackage -> m ToFetchResult getToFetch mdest resolvedAll = do (toFetch0, unpacked) <- liftM partitionEithers $ mapM checkUnpacked $ Map.toList resolvedAll toFetch1 <- mapM goIndex $ Map.toList $ Map.fromListWith (++) toFetch0 return ToFetchResult { tfrToFetch = Map.unions toFetch1 , tfrAlreadyUnpacked = Map.fromList unpacked } where checkUnpacked (ident, resolved) = do dirRel <- parseRelDir $ packageIdentifierString ident let mdestDir = ( dirRel) <$> mdest mexists <- case mdestDir of Nothing -> return Nothing Just destDir -> do exists <- doesDirExist destDir return $ if exists then Just destDir else Nothing case mexists of Just destDir -> return $ Right (ident, destDir) Nothing -> do let index = rpIndex resolved d = pcDownload $ rpCache resolved targz = T.pack $ packageIdentifierString ident ++ ".tar.gz" tarball <- configPackageTarball (indexName index) ident return $ Left (indexName index, [(ident, rpCache resolved, rpGitSHA1 resolved, ToFetch { tfTarball = tarball , tfDestDir = mdestDir , tfUrl = case d of Just d' -> decodeUtf8 $ pdUrl d' Nothing -> indexDownloadPrefix index <> targz , tfSize = fmap pdSize d , tfSHA512 = fmap pdSHA512 d , tfCabal = S.empty -- filled in by goIndex })]) goIndex (name, pkgs) = liftM Map.fromList $ withCabalFiles name pkgs $ \ident tf cabalBS -> return (ident, tf { tfCabal = cabalBS }) -- | Download the given name,version pairs into the directory expected by cabal. -- -- For each package it downloads, it will optionally unpack it to the given -- @Path@ (if present). Note that unpacking is not simply a matter of -- untarring, but also of grabbing the cabal file from the package index. The -- destinations should not include package identifiers. -- -- Returns the list of paths unpacked, including package identifiers. E.g.: -- -- @ -- fetchPackages [("foo-1.2.3", Just "/some/dest")] ==> ["/some/dest/foo-1.2.3"] -- @ -- -- Since 0.1.0.0 fetchPackages' :: (MonadIO m,MonadReader env m,HasHttpManager env,HasConfig env,MonadLogger m,MonadThrow m,MonadBaseControl IO m) => Maybe (Path Rel Dir) -- ^ the dist rename directory, see: https://github.com/fpco/stack/issues/157 -> Map PackageIdentifier ToFetch -> m (Map PackageIdentifier (Path Abs Dir)) fetchPackages' mdistDir toFetchAll = do connCount <- asks $ configConnectionCount . getConfig outputVar <- liftIO $ newTVarIO Map.empty runInBase <- liftBaseWith $ \run -> return (void . run) parMapM_ connCount (go outputVar runInBase) (Map.toList toFetchAll) liftIO $ readTVarIO outputVar where go :: (MonadIO m,MonadThrow m,MonadLogger m,MonadReader env m,HasHttpManager env) => TVar (Map PackageIdentifier (Path Abs Dir)) -> (m () -> IO ()) -> (PackageIdentifier, ToFetch) -> m () go outputVar runInBase (ident, toFetch) = do req <- parseUrl $ T.unpack $ tfUrl toFetch let destpath = tfTarball toFetch let toHashCheck bs = HashCheck SHA512 (CheckHexDigestByteString bs) let downloadReq = DownloadRequest { drRequest = req , drHashChecks = map toHashCheck $ maybeToList (tfSHA512 toFetch) , drLengthCheck = fromIntegral <$> tfSize toFetch , drRetryPolicy = drRetryPolicyDefault } let progressSink _ = liftIO $ runInBase $ $logInfo $ packageIdentifierText ident <> ": download" _ <- verifiedDownload downloadReq destpath progressSink let fp = toFilePath destpath F.forM_ (tfDestDir toFetch) $ \destDir -> do let dest = toFilePath $ parent destDir innerDest = toFilePath destDir liftIO $ ensureDir (parent destDir) liftIO $ withBinaryFile fp ReadMode $ \h -> do -- Avoid using L.readFile, which is more likely to leak -- resources lbs <- L.hGetContents h let entries = fmap (either wrap wrap) $ Tar.checkTarbomb identStr $ Tar.read $ decompress lbs wrap :: Exception e => e -> FetchException wrap = Couldn'tReadPackageTarball fp . toException identStr = packageIdentifierString ident getPerms :: Tar.Entry -> (FilePath, Tar.Permissions) getPerms e = (dest FP. Tar.fromTarPath (Tar.entryTarPath e), Tar.entryPermissions e) filePerms :: [(FilePath, Tar.Permissions)] filePerms = catMaybes $ Tar.foldEntries (\e -> (:) (Just $ getPerms e)) [] (const []) entries Tar.unpack dest entries -- Reset file permissions as they were in the tarball mapM_ (\(fp', perm) -> setFileMode (FP.dropTrailingPathSeparator fp') perm) filePerms case mdistDir of Nothing -> return () -- See: https://github.com/fpco/stack/issues/157 Just distDir -> do let inner = dest FP. identStr oldDist = inner FP. "dist" newDist = inner FP. toFilePath distDir exists <- D.doesDirectoryExist oldDist when exists $ do -- Previously used takeDirectory, but that got confused -- by trailing slashes, see: -- https://github.com/commercialhaskell/stack/issues/216 -- -- Instead, use Path which is a bit more resilient ensureDir . parent =<< parseAbsDir newDist D.renameDirectory oldDist newDist let cabalFP = innerDest FP. packageNameString (packageIdentifierName ident) <.> "cabal" S.writeFile cabalFP $ tfCabal toFetch atomically $ modifyTVar outputVar $ Map.insert ident destDir parMapM_ :: (F.Foldable f,MonadIO m,MonadBaseControl IO m) => Int -> (a -> m ()) -> f a -> m () parMapM_ (max 1 -> 1) f xs = F.mapM_ f xs parMapM_ cnt f xs0 = do var <- liftIO (newTVarIO $ F.toList xs0) -- See comment on similar line in Stack.Build runInBase <- liftBaseWith $ \run -> return (void . run) let worker = fix $ \loop -> join $ atomically $ do xs <- readTVar var case xs of [] -> return $ return () x:xs' -> do writeTVar var xs' return $ do runInBase $ f x loop workers 1 = Concurrently worker workers i = Concurrently worker *> workers (i - 1) liftIO $ runConcurrently $ workers cnt damerauLevenshtein :: String -> String -> Int damerauLevenshtein = ED.restrictedDamerauLevenshteinDistance ED.defaultEditCosts orSeparated :: NonEmpty String -> String orSeparated xs | NE.length xs == 1 = NE.head xs | NE.length xs == 2 = NE.head xs <> " or " <> NE.last xs | otherwise = intercalate ", " (NE.init xs) <> ", or " <> NE.last xs commaSeparated :: NonEmpty String -> String commaSeparated = F.fold . NE.intersperse ", " stack-1.1.2/src/Stack/FileWatch.hs0000644000000000000000000001262512661616322015057 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} module Stack.FileWatch ( fileWatch , fileWatchPoll , printExceptionStderr ) where import Blaze.ByteString.Builder (toLazyByteString, copyByteString) import Blaze.ByteString.Builder.Char.Utf8 (fromShow) import Control.Concurrent.Async (race_) import Control.Concurrent.STM import Control.Exception (Exception, fromException) import Control.Exception.Enclosed (tryAny) import Control.Monad (forever, unless, when) import qualified Data.ByteString.Lazy as L import qualified Data.Map.Strict as Map import Data.Monoid ((<>)) import Data.Set (Set) import qualified Data.Set as Set import Data.String (fromString) import Data.Traversable (forM) import GHC.IO.Handle (hIsTerminalDevice) import Path import System.Console.ANSI import System.Exit import System.FSNotify import System.IO (Handle, stdout, stderr, hPutStrLn) -- | Print an exception to stderr printExceptionStderr :: Exception e => e -> IO () printExceptionStderr e = L.hPut stderr $ toLazyByteString $ fromShow e <> copyByteString "\n" fileWatch :: Handle -> ((Set (Path Abs File) -> IO ()) -> IO ()) -> IO () fileWatch = fileWatchConf defaultConfig fileWatchPoll :: Handle -> ((Set (Path Abs File) -> IO ()) -> IO ()) -> IO () fileWatchPoll = fileWatchConf $ defaultConfig { confUsePolling = True } -- | Run an action, watching for file changes -- -- The action provided takes a callback that is used to set the files to be -- watched. When any of those files are changed, we rerun the action again. fileWatchConf :: WatchConfig -> Handle -> ((Set (Path Abs File) -> IO ()) -> IO ()) -> IO () fileWatchConf cfg out inner = withManagerConf cfg $ \manager -> do let putLn = hPutStrLn out let withColor color action = do outputIsTerminal <- hIsTerminalDevice stdout if outputIsTerminal then do setSGR [SetColor Foreground Dull color] action setSGR [Reset] else action allFiles <- newTVarIO Set.empty dirtyVar <- newTVarIO True watchVar <- newTVarIO Map.empty let onChange event = atomically $ do files <- readTVar allFiles when (eventPath event `Set.member` files) (writeTVar dirtyVar True) setWatched :: Set (Path Abs File) -> IO () setWatched files = do atomically $ writeTVar allFiles $ Set.map toFilePath files watch0 <- readTVarIO watchVar let actions = Map.mergeWithKey keepListening stopListening startListening watch0 newDirs watch1 <- forM (Map.toList actions) $ \(k, mmv) -> do mv <- mmv return $ case mv of Nothing -> Map.empty Just v -> Map.singleton k v atomically $ writeTVar watchVar $ Map.unions watch1 where newDirs = Map.fromList $ map (, ()) $ Set.toList $ Set.map parent files keepListening _dir listen () = Just $ return $ Just listen stopListening = Map.map $ \f -> do () <- f return Nothing startListening = Map.mapWithKey $ \dir () -> do let dir' = fromString $ toFilePath dir listen <- watchDir manager dir' (const True) onChange return $ Just listen let watchInput = do line <- getLine unless (line == "quit") $ do case line of "help" -> do putLn "" putLn "help: display this help" putLn "quit: exit" putLn "build: force a rebuild" putLn "watched: display watched files" "build" -> atomically $ writeTVar dirtyVar True "watched" -> do watch <- readTVarIO allFiles mapM_ putLn (Set.toList watch) "" -> atomically $ writeTVar dirtyVar True _ -> putLn $ concat [ "Unknown command: " , show line , ". Try 'help'" ] watchInput race_ watchInput $ forever $ do atomically $ do dirty <- readTVar dirtyVar check dirty eres <- tryAny $ inner setWatched -- Clear dirtiness flag after the build to avoid an infinite -- loop caused by the build itself triggering dirtiness. This -- could be viewed as a bug, since files changed during the -- build will not trigger an extra rebuild, but overall seems -- like better behavior. See -- https://github.com/commercialhaskell/stack/issues/822 atomically $ writeTVar dirtyVar False case eres of Left e -> do let color = case fromException e of Just ExitSuccess -> Green _ -> Red withColor color $ printExceptionStderr e _ -> withColor Green $ putLn "Success! Waiting for next file change." putLn "Type help for available commands. Press enter to force a rebuild." stack-1.1.2/src/Stack/GhcPkg.hs0000644000000000000000000001464412717707440014363 0ustar0000000000000000-- FIXME See how much of this module can be deleted. {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS -fno-warn-unused-do-bind #-} -- | Functions for the GHC package database. module Stack.GhcPkg (getGlobalDB ,EnvOverride ,envHelper ,createDatabase ,unregisterGhcPkgId ,getCabalPkgVer ,ghcPkgExeName ,mkGhcPackagePath) where import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Trans.Control import qualified Data.ByteString.Char8 as S8 import Data.Either import Data.List import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Path (Path, Abs, Dir, toFilePath, parent) import Path.Extra (toFilePathNoTrailingSep) import Path.IO import Prelude hiding (FilePath) import Stack.Constants import Stack.Types import System.FilePath (searchPathSeparator) import System.Process.Read -- | Get the global package database getGlobalDB :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> WhichCompiler -> m (Path Abs Dir) getGlobalDB menv wc = do $logDebug "Getting global package database location" -- This seems like a strange way to get the global package database -- location, but I don't know of a better one bs <- ghcPkg menv wc [] ["list", "--global"] >>= either throwM return let fp = S8.unpack $ stripTrailingColon $ firstLine bs resolveDir' fp where stripTrailingColon bs | S8.null bs = bs | S8.last bs == ':' = S8.init bs | otherwise = bs firstLine = S8.takeWhile (\c -> c /= '\r' && c /= '\n') -- | Run the ghc-pkg executable ghcPkg :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> WhichCompiler -> [Path Abs Dir] -> [String] -> m (Either ReadProcessException S8.ByteString) ghcPkg menv wc pkgDbs args = do eres <- go case eres of Left _ -> do mapM_ (createDatabase menv wc) pkgDbs go Right _ -> return eres where go = tryProcessStdout Nothing menv (ghcPkgExeName wc) args' args' = packageDbFlags pkgDbs ++ args -- | Create a package database in the given directory, if it doesn't exist. createDatabase :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> WhichCompiler -> Path Abs Dir -> m () createDatabase menv wc db = do exists <- doesDirExist db unless exists $ do -- Creating the parent doesn't seem necessary, as ghc-pkg -- seems to be sufficiently smart. But I don't feel like -- finding out it isn't the hard way ensureDir (parent db) _ <- tryProcessStdout Nothing menv (ghcPkgExeName wc) ["init", toFilePath db] return () -- | Get the name to use for "ghc-pkg", given the compiler version. ghcPkgExeName :: WhichCompiler -> String ghcPkgExeName Ghc = "ghc-pkg" ghcPkgExeName Ghcjs = "ghcjs-pkg" -- | Get the necessary ghc-pkg flags for setting up the given package database packageDbFlags :: [Path Abs Dir] -> [String] packageDbFlags pkgDbs = "--no-user-package-db" : map (\x -> "--package-db=" ++ toFilePath x) pkgDbs -- | Get the value of a field of the package. findGhcPkgField :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> WhichCompiler -> [Path Abs Dir] -- ^ package databases -> String -- ^ package identifier, or GhcPkgId -> Text -> m (Maybe Text) findGhcPkgField menv wc pkgDbs name field = do result <- ghcPkg menv wc pkgDbs ["field", "--simple-output", name, T.unpack field] return $ case result of Left{} -> Nothing Right lbs -> fmap (stripCR . T.decodeUtf8) $ listToMaybe $ S8.lines lbs where stripCR t = fromMaybe t (T.stripSuffix "\r" t) -- | Get the version of the package findGhcPkgVersion :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> WhichCompiler -> [Path Abs Dir] -- ^ package databases -> PackageName -> m (Maybe Version) findGhcPkgVersion menv wc pkgDbs name = do mv <- findGhcPkgField menv wc pkgDbs (packageNameString name) "version" case mv of Just !v -> return (parseVersion v) _ -> return Nothing unregisterGhcPkgId :: (MonadIO m, MonadLogger m, MonadCatch m, MonadBaseControl IO m) => EnvOverride -> WhichCompiler -> CompilerVersion -> Path Abs Dir -- ^ package database -> GhcPkgId -> PackageIdentifier -> m () unregisterGhcPkgId menv wc cv pkgDb gid ident = do eres <- ghcPkg menv wc [pkgDb] args case eres of Left e -> $logWarn $ T.pack $ show e Right _ -> return () where -- TODO ideally we'd tell ghc-pkg a GhcPkgId instead args = "unregister" : "--user" : "--force" : (case cv of GhcVersion v | v < $(mkVersion "7.9") -> [packageIdentifierString ident] _ -> ["--ipid", ghcPkgIdString gid]) -- | Get the version of Cabal from the global package database. getCabalPkgVer :: (MonadThrow m, MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> WhichCompiler -> m Version getCabalPkgVer menv wc = do $logDebug "Getting Cabal package version" mres <- findGhcPkgVersion menv wc [] -- global DB cabalPackageName maybe (throwM $ Couldn'tFindPkgId cabalPackageName) return mres -- | Get the value for GHC_PACKAGE_PATH mkGhcPackagePath :: Bool -> Path Abs Dir -> Path Abs Dir -> [Path Abs Dir] -> Path Abs Dir -> Text mkGhcPackagePath locals localdb deps extras globaldb = T.pack $ intercalate [searchPathSeparator] $ concat [ [toFilePathNoTrailingSep localdb | locals] , [toFilePathNoTrailingSep deps] , [toFilePathNoTrailingSep db | db <- reverse extras] , [toFilePathNoTrailingSep globaldb] ] stack-1.1.2/src/Stack/Ghci.hs0000644000000000000000000006216512717707440014073 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} -- | Run a GHCi configured with the user's package(s). module Stack.Ghci ( GhciOpts(..) , GhciPkgInfo(..) , GhciException(..) , ghciSetup , ghci ) where import Control.Applicative import Control.Exception.Enclosed (tryAny) import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.RWS.Strict import Control.Monad.State.Strict import Control.Monad.Trans.Unlift (MonadBaseUnlift) import qualified Data.ByteString.Char8 as S8 import Data.Either import Data.Function import Data.List import Data.List.Extra (nubOrd) import Data.List.Split (splitOn) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe import Data.Maybe.Extra (forMaybeM) import Data.Set (Set) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Data.Typeable (Typeable) import Distribution.ModuleName (ModuleName) import Distribution.Text (display) import Network.HTTP.Client.Conduit import Path import Path.Extra (toFilePathNoTrailingSep) import Path.IO import Prelude import Stack.Build import Stack.Build.Installed import Stack.Build.Source import Stack.Build.Target import Stack.Constants import Stack.Exec import Stack.Package import Stack.Types import Stack.Types.Internal import System.FilePath (takeBaseName) import Text.Read (readMaybe) #ifndef WINDOWS import qualified System.Posix.Files as Posix #endif -- | Command-line options for GHC. data GhciOpts = GhciOpts { ghciNoBuild :: !Bool , ghciArgs :: ![String] , ghciGhcCommand :: !(Maybe FilePath) , ghciNoLoadModules :: !Bool , ghciAdditionalPackages :: ![String] , ghciMainIs :: !(Maybe Text) , ghciLoadLocalDeps :: !Bool , ghciSkipIntermediate :: !Bool , ghciHidePackages :: !Bool , ghciBuildOptsCLI :: !BuildOptsCLI } deriving Show -- | Necessary information to load a package or its components. data GhciPkgInfo = GhciPkgInfo { ghciPkgName :: !PackageName , ghciPkgOpts :: ![(NamedComponent, BuildInfoOpts)] , ghciPkgDir :: !(Path Abs Dir) , ghciPkgModules :: !(Set ModuleName) , ghciPkgModFiles :: !(Set (Path Abs File)) -- ^ Module file paths. , ghciPkgCFiles :: !(Set (Path Abs File)) -- ^ C files. , ghciPkgMainIs :: !(Map NamedComponent (Set (Path Abs File))) , ghciPkgPackage :: !Package } deriving Show data GhciException = InvalidPackageOption String | LoadingDuplicateModules deriving (Typeable) instance Exception GhciException instance Show GhciException where show (InvalidPackageOption name) = "Failed to parse --package option " ++ name show LoadingDuplicateModules = unlines [ "Not attempting to start ghci due to these duplicate modules." , "Use --no-load to try to start it anyway, without loading any modules (but these are still likely to cause errors)" ] -- | Launch a GHCi session for the given local package targets with the -- given options and configure it with the load paths and extensions -- of those targets. ghci :: (HasBuildConfig r, HasHttpManager r, MonadMask m, HasLogLevel r, HasTerminal r, HasEnvConfig r, MonadReader r m, MonadIO m, MonadLogger m, MonadBaseUnlift IO m) => GhciOpts -> m () ghci opts@GhciOpts{..} = do bopts <- asks (configBuild . getConfig) (targets,mainIsTargets,pkgs) <- ghciSetup opts config <- asks getConfig bconfig <- asks getBuildConfig wc <- getWhichCompiler let pkgopts = hidePkgOpt ++ genOpts ++ ghcOpts hidePkgOpt = if null pkgs || not ghciHidePackages then [] else ["-hide-all-packages"] oneWordOpts bio | ghciHidePackages = bioOneWordOpts bio ++ bioPackageFlags bio | otherwise = bioOneWordOpts bio genOpts = nubOrd (concatMap (concatMap (oneWordOpts . snd) . ghciPkgOpts) pkgs) (omittedOpts, ghcOpts) = partition badForGhci $ concatMap (concatMap (bioOpts . snd) . ghciPkgOpts) pkgs ++ getUserOptions Nothing ++ concatMap (getUserOptions . Just . ghciPkgName) pkgs getUserOptions mpkg = map T.unpack (M.findWithDefault [] mpkg (unGhcOptions (configGhcOptions config))) badForGhci x = isPrefixOf "-O" x || elem x (words "-debug -threaded -ticky -static -Werror") unless (null omittedOpts) $ $logWarn ("The following GHC options are incompatible with GHCi and have not been passed to it: " <> T.unwords (map T.pack (nubOrd omittedOpts))) allModules <- checkForDuplicateModules ghciNoLoadModules pkgs oiDir <- objectInterfaceDir bconfig (modulesToLoad, mainFile) <- if ghciNoLoadModules then return ([], Nothing) else do mmainFile <- figureOutMainFile bopts mainIsTargets targets pkgs modulesToLoad <- case mmainFile of Just mainFile -> do let (_, mfDirs, mfName) = filePathPieces mainFile mainPathPieces = map toFilePath mfDirs ++ [takeBaseName (toFilePath mfName)] liftM catMaybes $ forM allModules $ \mn -> do let matchesModule = splitOn "." mn `isSuffixOf` mainPathPieces if matchesModule then do $logWarn $ "Warning: Omitting load of module " <> T.pack mn <> ", because it matches the filepath of the Main target, " <> T.pack (toFilePath mainFile) return Nothing else return (Just mn) Nothing -> return allModules return (modulesToLoad, mmainFile) let odir = [ "-odir=" <> toFilePathNoTrailingSep oiDir , "-hidir=" <> toFilePathNoTrailingSep oiDir ] $logInfo ("Configuring GHCi with the following packages: " <> T.intercalate ", " (map (packageNameText . ghciPkgName) pkgs)) let execGhci extras = do menv <- liftIO $ configEnvOverride config defaultEnvSettings execSpawn menv (fromMaybe (compilerExeName wc) ghciGhcCommand) ("--interactive" : -- This initial "-i" resets the include directories to not -- include CWD. "-i" : odir <> pkgopts <> ghciArgs <> extras) withSystemTempDir "ghci" $ \tmpDir -> do let macrosFile = tmpDir $(mkRelFile "cabal_macros.h") macrosOpts <- preprocessCabalMacros pkgs macrosFile if ghciNoLoadModules then execGhci macrosOpts else do let scriptPath = tmpDir $(mkRelFile "ghci-script") fp = toFilePath scriptPath loadModules = ":add " <> unwords (map show modulesToLoad) addMainFile = maybe "" ((":add " <>) . toFilePath) mainFile bringIntoScope = ":module + " <> unwords modulesToLoad liftIO (writeFile fp (unlines [loadModules,addMainFile,bringIntoScope])) setScriptPerms fp execGhci (macrosOpts ++ ["-ghci-script=" <> fp]) -- | Figure out the main-is file to load based on the targets. Sometimes there -- is none, sometimes it's unambiguous, sometimes it's -- ambiguous. Warns and returns nothing if it's ambiguous. figureOutMainFile :: (MonadLogger m, MonadIO m) => BuildOpts -> Maybe (Map PackageName SimpleTarget) -> Map PackageName SimpleTarget -> [GhciPkgInfo] -> m (Maybe (Path Abs File)) figureOutMainFile bopts mainIsTargets targets0 packages = case candidates of [] -> return Nothing [c@(_,_,fp)] -> do $logInfo ("Using main module: " <> renderCandidate c) return (Just fp) candidate:_ -> do borderedWarning $ do $logWarn "The main module to load is ambiguous. Candidates are: " forM_ (map renderCandidate candidates) $logWarn $logWarn "You can specify which one to pick by: " $logWarn (" * Specifying targets to stack ghci e.g. stack ghci " <> sampleTargetArg candidate) $logWarn (" * Specifying what the main is e.g. stack ghci " <> sampleMainIsArg candidate) $logWarn (" * Choosing from the candidate above [1.." <> T.pack (show $ length candidates) <> "]") liftIO userOption where targets = fromMaybe targets0 mainIsTargets candidates = do pkg <- packages case M.lookup (ghciPkgName pkg) targets of Nothing -> [] Just target -> do (component,mains) <- M.toList $ M.filterWithKey (\k _ -> k `S.member` wantedComponents) (ghciPkgMainIs pkg) main <- S.toList mains return (ghciPkgName pkg, component, main) where wantedComponents = wantedPackageComponents bopts target (ghciPkgPackage pkg) renderCandidate c@(pkgName,namedComponent,mainIs) = let candidateIndex = T.pack . show . (+1) . fromMaybe 0 . elemIndex c in candidateIndex candidates <> ". Package `" <> packageNameText pkgName <> "' component " <> renderComp namedComponent <> " with main-is file: " <> T.pack (toFilePath mainIs) candidateIndices = take (length candidates) [1 :: Int ..] userOption = do putStr "Specify main module to use (press enter to load none): " option <- getLine let selected = fromMaybe ((+1) $ length candidateIndices) (readMaybe option :: Maybe Int) case elemIndex selected candidateIndices of Nothing -> do putStrLn "Not loading any main modules, as no valid module selected" putStrLn "" return Nothing Just op -> do let (_,_,fp) = candidates !! op putStrLn ("Loading main module from cadidate " <> show (op + 1) <> ", --main-is " <> toFilePath fp) putStrLn "" return $ Just fp renderComp c = case c of CLib -> "lib" CExe name -> "exe:" <> name CTest name -> "test:" <> name CBench name -> "bench:" <> name sampleTargetArg (pkg,comp,_) = packageNameText pkg <> ":" <> renderComp comp sampleMainIsArg (pkg,comp,_) = "--main-is " <> packageNameText pkg <> ":" <> renderComp comp -- | Create a list of infos for each target containing necessary -- information to load that package/components. ghciSetup :: (HasHttpManager r, HasBuildConfig r, MonadMask m, HasTerminal r, HasLogLevel r, HasEnvConfig r, MonadReader r m, MonadIO m, MonadLogger m, MonadBaseUnlift IO m) => GhciOpts -> m (Map PackageName SimpleTarget, Maybe (Map PackageName SimpleTarget), [GhciPkgInfo]) ghciSetup GhciOpts{..} = do (_,_,targets) <- parseTargetsFromBuildOpts AllowNoTargets ghciBuildOptsCLI mainIsTargets <- case ghciMainIs of Nothing -> return Nothing Just target -> do (_,_,targets') <- parseTargetsFromBuildOpts AllowNoTargets ghciBuildOptsCLI { boptsCLITargets = [target] } return (Just targets') addPkgs <- forM ghciAdditionalPackages $ \name -> do let mres = (packageIdentifierName <$> parsePackageIdentifierFromString name) <|> parsePackageNameFromString name maybe (throwM $ InvalidPackageOption name) return mres let boptsCli = ghciBuildOptsCLI { boptsCLITargets = boptsCLITargets ghciBuildOptsCLI ++ map T.pack ghciAdditionalPackages } -- Try to build, but optimistically launch GHCi anyway if it fails (#1065) unless ghciNoBuild $ do eres <- tryAny $ build (const (return ())) Nothing boptsCli case eres of Right () -> return () Left err -> do $logError $ T.pack (show err) $logWarn "Warning: build failed, but optimistically launching GHCi anyway" econfig <- asks getEnvConfig (realTargets,_,_,_,sourceMap) <- loadSourceMap AllowNoTargets boptsCli menv <- getMinimalEnvOverride (installedMap, _, _, _) <- getInstalled menv GetInstalledOpts { getInstalledProfiling = False , getInstalledHaddock = False } sourceMap directlyWanted <- forMaybeM (M.toList (envConfigPackages econfig)) $ \(dir,treatLikeExtraDep) -> do cabalfp <- findOrGenerateCabalFile dir name <- parsePackageNameFromFilePath cabalfp if treatLikeExtraDep then return Nothing else case M.lookup name targets of Just simpleTargets -> return (Just (name, (cabalfp, simpleTargets))) Nothing -> return Nothing let extraLoadDeps = getExtraLoadDeps ghciLoadLocalDeps sourceMap directlyWanted wanted <- if (ghciSkipIntermediate && not ghciLoadLocalDeps) || null extraLoadDeps then return directlyWanted else do let extraList = T.intercalate ", " (map (packageNameText . fst) extraLoadDeps) if ghciLoadLocalDeps then $logInfo $ T.concat [ "The following libraries will also be loaded into GHCi because " , "they are local dependencies of your targets, and you specified --load-local-deps:\n " , extraList ] else $logInfo $ T.concat [ "The following libraries will also be loaded into GHCi because " , "they are intermediate dependencies of your targets:\n " , extraList , "\n(Use --skip-intermediate-deps to omit these)" ] return (directlyWanted ++ extraLoadDeps) -- Load the list of modules _after_ building, to catch changes in unlisted dependencies (#1180) let localLibs = [name | (name, (_, target)) <- wanted, hasLocalComp isCLib target] infos <- forM wanted $ \(name,(cabalfp,target)) -> makeGhciPkgInfo boptsCli sourceMap installedMap localLibs addPkgs name cabalfp target checkForIssues infos return (realTargets, mainIsTargets, infos) where hasLocalComp p t = case t of STLocalComps s -> any p (S.toList s) STLocalAll -> True _ -> False -- | Make information necessary to load the given package in GHCi. makeGhciPkgInfo :: (MonadReader r m, HasEnvConfig r, MonadLogger m, MonadIO m, MonadCatch m) => BuildOptsCLI -> SourceMap -> InstalledMap -> [PackageName] -> [PackageName] -> PackageName -> Path Abs File -> SimpleTarget -> m GhciPkgInfo makeGhciPkgInfo boptsCli sourceMap installedMap locals addPkgs name cabalfp target = do bopts <- asks (configBuild . getConfig) econfig <- asks getEnvConfig bconfig <- asks getBuildConfig let config = PackageConfig { packageConfigEnableTests = True , packageConfigEnableBenchmarks = True , packageConfigFlags = getLocalFlags bconfig boptsCli name , packageConfigGhcOptions = getGhcOptions bconfig boptsCli name True True , packageConfigCompilerVersion = envConfigCompilerVersion econfig , packageConfigPlatform = configPlatform (getConfig bconfig) } (warnings,pkg) <- readPackage config cabalfp mapM_ (printCabalFileWarning cabalfp) warnings (mods,files,opts) <- getPackageOpts (packageOpts pkg) sourceMap installedMap locals addPkgs cabalfp let filteredOpts = filterWanted opts filterWanted = M.filterWithKey (\k _ -> k `S.member` allWanted) allWanted = wantedPackageComponents bopts target pkg setMapMaybe f = S.fromList . mapMaybe f . S.toList return GhciPkgInfo { ghciPkgName = packageName pkg , ghciPkgOpts = M.toList filteredOpts , ghciPkgDir = parent cabalfp , ghciPkgModules = mconcat (M.elems (filterWanted mods)) , ghciPkgModFiles = mconcat (M.elems (filterWanted (M.map (setMapMaybe dotCabalModulePath) files))) , ghciPkgMainIs = M.map (setMapMaybe dotCabalMainPath) files , ghciPkgCFiles = mconcat (M.elems (filterWanted (M.map (setMapMaybe dotCabalCFilePath) files))) , ghciPkgPackage = pkg } -- NOTE: this should make the same choices as the components code in -- 'loadLocalPackage'. Unfortunately for now we reiterate this logic -- (differently). wantedPackageComponents :: BuildOpts -> SimpleTarget -> Package -> Set NamedComponent wantedPackageComponents _ (STLocalComps cs) _ = cs wantedPackageComponents bopts STLocalAll pkg = S.fromList $ (if packageHasLibrary pkg then [CLib] else []) ++ map CExe (S.toList (packageExes pkg)) <> (if boptsTests bopts then map CTest (M.keys (packageTests pkg)) else []) <> (if boptsBenchmarks bopts then map CBench (S.toList (packageBenchmarks pkg)) else []) wantedPackageComponents _ _ _ = S.empty checkForIssues :: (MonadThrow m, MonadLogger m) => [GhciPkgInfo] -> m () checkForIssues pkgs = do unless (null issues) $ borderedWarning $ do $logWarn "There are issues with this project which may prevent GHCi from working properly." $logWarn "" mapM_ $logWarn $ intercalate [""] issues $logWarn "" $logWarn "To resolve, remove the flag(s) from the cabal file(s) and instead put them at the top of the haskell files." $logWarn "" $logWarn "It isn't yet possible to load multiple packages into GHCi in all cases - see" $logWarn "https://ghc.haskell.org/trac/ghc/ticket/10827" where issues = concat [ mixedFlag "-XNoImplicitPrelude" [ "-XNoImplicitPrelude will be used, but GHCi will likely fail to build things which depend on the implicit prelude." ] , mixedFlag "-XCPP" [ "-XCPP will be used, but it can cause issues with multiline strings." , "See https://downloads.haskell.org/~ghc/7.10.2/docs/html/users_guide/options-phases.html#cpp-string-gaps" ] , mixedFlag "-XNoTraditionalRecordSyntax" [ "-XNoTraditionalRecordSyntax will be used, but it break modules which use record syntax." ] , mixedFlag "-XTemplateHaskell" [ "-XTemplateHaskell will be used, but it may cause compilation issues due to different parsing of '$' when there's no space after it." ] , mixedFlag "-XQuasiQuotes" [ "-XQuasiQuotes will be used, but it may cause parse failures due to a different meaning for list comprehension syntax like [x| ... ]" ] , mixedFlag "-XSafe" [ "-XSafe will be used, but it will fail to compile unsafe modules." ] , mixedFlag "-XArrows" [ "-XArrows will be used, but it will cause non-arrow usages of proc, (-<), (-<<) to fail" ] , mixedFlag "-XOverloadedStrings" [ "-XOverloadedStrings will be used, but it can cause type ambiguity in code not usually compiled with it." ] , mixedFlag "-XOverloadedLists" [ "-XOverloadedLists will be used, but it can cause type ambiguity in code not usually compiled with it." ] , mixedFlag "-XMonoLocalBinds" [ "-XMonoLocalBinds will be used, but it can cause type errors in code which expects generalized local bindings." ] , mixedFlag "-XTypeFamilies" [ "-XTypeFamilies will be used, but it implies -XMonoLocalBinds, and so can cause type errors in code which expects generalized local bindings." ] , mixedFlag "-XGADTs" [ "-XGADTs will be used, but it implies -XMonoLocalBinds, and so can cause type errors in code which expects generalized local bindings." ] , mixedFlag "-XNewQualifiedOperators" [ "-XNewQualifiedOperators will be used, but this will break usages of the old qualified operator syntax." ] ] mixedFlag flag msgs = let x = partitionComps (== flag) in [ msgs ++ showWhich x | mixedSettings x ] mixedSettings (xs, ys) = xs /= [] && ys /= [] showWhich (haveIt, don'tHaveIt) = [ "It is specified for:" , " " <> renderPkgComponents haveIt , "But not for: " , " " <> renderPkgComponents don'tHaveIt ] partitionComps f = (map fst xs, map fst ys) where (xs, ys) = partition (any f . snd) compsWithOpts compsWithOpts = map (\(k, bio) -> (k, bioOneWordOpts bio ++ bioOpts bio)) compsWithBios compsWithBios = [ ((ghciPkgName pkg, c), bio) | pkg <- pkgs , (c, bio) <- ghciPkgOpts pkg ] borderedWarning :: MonadLogger m => m a -> m a borderedWarning f = do $logWarn "" $logWarn "* * * * * * * *" x <- f $logWarn "* * * * * * * *" $logWarn "" return x checkForDuplicateModules :: (MonadThrow m, MonadLogger m) => Bool -> [GhciPkgInfo] -> m [String] checkForDuplicateModules noLoadModules pkgs = do unless (null duplicates) $ do borderedWarning $ do $logWarn "The following modules are present in multiple packages:" forM_ duplicates $ \(mn, pns) -> do $logWarn (" * " <> T.pack mn <> " (in " <> T.intercalate ", " (map packageNameText pns) <> ")") unless noLoadModules $ throwM LoadingDuplicateModules return (map fst allModules) where duplicates, allModules :: [(String, [PackageName])] duplicates = filter (not . null . tail . snd) allModules allModules = M.toList $ M.fromListWith (++) $ concatMap (\pkg -> map (, [ghciPkgName pkg]) (map display (S.toList (ghciPkgModules pkg)))) pkgs -- Adds in intermediate dependencies between ghci targets. Note that it -- will return a Lib component for these intermediate dependencies even -- if they don't have a library (but that's fine for the usage within -- this module). -- -- If 'True' is passed for loadAllDeps, this loads all local deps, even -- if they aren't intermediate. getExtraLoadDeps :: Bool -> SourceMap -> [(PackageName, (Path Abs File, SimpleTarget))] -> [(PackageName, (Path Abs File, SimpleTarget))] getExtraLoadDeps loadAllDeps sourceMap targets = M.toList $ (\mp -> foldl' (flip M.delete) mp (map fst targets)) $ M.mapMaybe id $ execState (mapM_ (mapM_ go . getDeps . fst) targets) (M.fromList (map (\(k, x) -> (k, Just x)) targets)) where getDeps :: PackageName -> [PackageName] getDeps name = case M.lookup name sourceMap of Just (PSLocal lp) -> M.keys (packageDeps (lpPackage lp)) _ -> [] go :: PackageName -> State (Map PackageName (Maybe (Path Abs File, SimpleTarget))) Bool go name = do cache <- get case (M.lookup name cache, M.lookup name sourceMap) of (Just (Just _), _) -> return True (Just Nothing, _) | not loadAllDeps -> return False (_, Just (PSLocal lp)) -> do let deps = M.keys (packageDeps (lpPackage lp)) shouldLoad <- liftM or $ mapM go deps if shouldLoad then do modify (M.insert name (Just (lpCabalFile lp, STLocalComps (S.singleton CLib)))) return True else do modify (M.insert name Nothing) return False (_, Just PSUpstream{}) -> return loadAllDeps (_, _) -> return False preprocessCabalMacros :: MonadIO m => [GhciPkgInfo] -> Path Abs File -> m [String] preprocessCabalMacros pkgs out = liftIO $ do let fps = nubOrd (concatMap (mapMaybe (bioCabalMacros . snd) . ghciPkgOpts) pkgs) files <- mapM (S8.readFile . toFilePath) fps if null files then return [] else do S8.writeFile (toFilePath out) $ S8.concat $ map (<> "\n#undef CURRENT_PACKAGE_KEY\n") files return ["-optP-include", "-optP" <> toFilePath out] setScriptPerms :: MonadIO m => FilePath -> m () #ifdef WINDOWS setScriptPerms _ = do return () #else setScriptPerms fp = do liftIO $ Posix.setFileMode fp $ foldl1 Posix.unionFileModes [ Posix.ownerReadMode , Posix.ownerWriteMode , Posix.groupReadMode , Posix.otherReadMode ] #endif filePathPieces :: Path Abs File -> (Path Abs Dir, [Path Rel Dir], Path Rel File) filePathPieces x0 = go (parent x0, [], filename x0) where go (x, dirs, fp) | parent x == x = (x, dirs, fp) | otherwise = (parent x, dirname x : dirs, fp) stack-1.1.2/src/Stack/Ide.hs0000644000000000000000000001130212717707441013706 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-} -- | Run a IDE configured with the user's package(s). module Stack.Ide (ide, getPackageOptsAndTargetFiles, ideGhciOpts) where import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader import Control.Monad.Trans.Unlift (MonadBaseUnlift) import Data.List import Data.Maybe import Data.Monoid import qualified Data.Set as S import Data.Text (Text) import Distribution.System import Network.HTTP.Client.Conduit import Path import Path.Extra (toFilePathNoTrailingSep) import Path.IO import Stack.Constants import Stack.Ghci (GhciPkgInfo(..), GhciOpts(..), ghciSetup) import Stack.Package import Stack.Types import Stack.Types.Internal import System.Environment (lookupEnv) import System.FilePath (searchPathSeparator) import System.Process.Run -- | Launch a GHCi IDE for the given local project targets with the -- given options and configure it with the load paths and extensions -- of those targets. ide :: (HasConfig r, HasBuildConfig r, HasTerminal r, HasLogLevel r, MonadMask m, HasEnvConfig r, MonadReader r m, MonadIO m, MonadLogger m, MonadBaseUnlift IO m, HasHttpManager r) => [Text] -- ^ Targets. -> [String] -- ^ GHC options. -> m () ide targets useropts = do let boptsCli = defaultBuildOptsCLI { boptsCLITargets = targets , boptsCLIBuildSubset = BSOnlyDependencies } (_realTargets,_,pkgs) <- ghciSetup (ideGhciOpts boptsCli) pwd <- getCurrentDir (pkgopts,_srcfiles) <- liftM mconcat $ forM pkgs $ getPackageOptsAndTargetFiles pwd localdb <- packageDatabaseLocal depsdb <- packageDatabaseDeps mpath <- liftIO $ lookupEnv "PATH" bindirs <- extraBinDirs `ap` return True {- include local bin -} let pkgdbs = ["--package-db=" <> toFilePathNoTrailingSep depsdb <> [searchPathSeparator] <> toFilePathNoTrailingSep localdb] paths = [ "--ide-backend-tools-path=" <> intercalate [searchPathSeparator] (map toFilePath bindirs) <> maybe "" (searchPathSeparator :) mpath] args = ["--verbose"] <> ["--include=" <> includeDirs pkgopts] <> ["--local-work-dir=" ++ toFilePathNoTrailingSep pwd] <> map ("--ghc-option=" ++) useropts <> paths <> pkgopts <> pkgdbs menv <- getMinimalEnvOverride Platform _ os <- asks getPlatform when (os == OSX) (catch (callProcess (Cmd (Just pwd) "stty" menv ["cbreak", "-imaxbel"])) (\(_ :: ProcessExitedUnsuccessfully) -> return ())) callProcess (Cmd (Just pwd) "stack-ide" menv args) where includeDirs pkgopts = intercalate [searchPathSeparator] (mapMaybe (stripPrefix "--ghc-option=-i") pkgopts) -- | Get options and target files for the given package info. getPackageOptsAndTargetFiles :: (MonadThrow m, MonadIO m, MonadReader env m, HasEnvConfig env) => Path Abs Dir -> GhciPkgInfo -> m ([FilePath], [FilePath]) getPackageOptsAndTargetFiles pwd pkg = do dist <- distDirFromDir (ghciPkgDir pkg) let autogen = autogenDir dist paths_foo <- liftM (autogen ) (parseRelFile ("Paths_" ++ packageNameString (ghciPkgName pkg) ++ ".hs")) paths_foo_exists <- doesFileExist paths_foo let ghcOptions bio = bioOneWordOpts bio ++ bioOpts bio ++ bioPackageFlags bio ++ maybe [] (\cabalMacros -> ["-optP-include", "-optP" <> toFilePath cabalMacros]) (bioCabalMacros bio) return ( ("--dist-dir=" <> toFilePathNoTrailingSep dist) : map ("--ghc-option=" ++) (concatMap (ghcOptions . snd) (ghciPkgOpts pkg)) , mapMaybe (fmap toFilePath . stripDir pwd) (S.toList (ghciPkgCFiles pkg) <> S.toList (ghciPkgModFiles pkg) <> [paths_foo | paths_foo_exists])) ideGhciOpts :: BuildOptsCLI -> GhciOpts ideGhciOpts boptsCli = GhciOpts { ghciNoBuild = False , ghciArgs = [] , ghciGhcCommand = Nothing , ghciNoLoadModules = False , ghciAdditionalPackages = [] , ghciMainIs = Nothing , ghciLoadLocalDeps = False , ghciSkipIntermediate = False , ghciHidePackages = True , ghciBuildOptsCLI = boptsCli } stack-1.1.2/src/Stack/Image.hs0000644000000000000000000002064412711161622014225 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} -- | This module builds Docker (OpenContainer) images. module Stack.Image (stageContainerImageArtifacts, createContainerImageFromStage, imgCmdName, imgDockerCmdName, imgOptsFromMonoid) where import Control.Exception.Lifted hiding (finally) import Control.Monad import Control.Monad.Catch hiding (bracket) import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader import Control.Monad.Trans.Control import Data.Char (toLower) import qualified Data.Map.Strict as Map import Data.Maybe import Data.Typeable import Data.Text (Text) import qualified Data.Text as T import Path import Path.Extra import Path.IO import Stack.Constants import Stack.Types import Stack.Types.Internal import System.Process.Run type Build e m = (HasBuildConfig e, HasConfig e, HasEnvConfig e, HasTerminal e, MonadBaseControl IO m, MonadCatch m, MonadIO m, MonadLogger m, MonadReader e m) type Assemble e m = (HasConfig e, HasTerminal e, MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m, MonadReader e m) -- | Stages the executables & additional content in a staging -- directory under '.stack-work' stageContainerImageArtifacts :: Build e m => Maybe (Path Abs Dir) -> m () stageContainerImageArtifacts mProjectRoot = do config <- asks getConfig forM_ (zip [0 ..] (imgDockers $ configImage config)) (\(idx,opts) -> do imageDir <- imageStagingDir (fromMaybeProjectRoot mProjectRoot) idx ignoringAbsence (removeDirRecur imageDir) ensureDir imageDir stageExesInDir opts imageDir syncAddContentToDir opts imageDir) -- | Builds a Docker (OpenContainer) image extending the `base` image -- specified in the project's stack.yaml. Then new image will be -- extended with an ENTRYPOINT specified for each `entrypoint` listed -- in the config file. createContainerImageFromStage :: Assemble e m => Maybe (Path Abs Dir) -> [Text] -> m () createContainerImageFromStage mProjectRoot imageNames = do config <- asks getConfig forM_ (zip [0 ..] (filterImages (map T.unpack imageNames) (imgDockers $ configImage config))) (\(idx,opts) -> do imageDir <- imageStagingDir (fromMaybeProjectRoot mProjectRoot) idx createDockerImage opts imageDir extendDockerImageWithEntrypoint opts imageDir) where filterImages [] = id -- all: no filter filterImages names = filter (imageNameFound names . imgDockerImageName) imageNameFound names (Just name) = name `elem` names imageNameFound _ _ = False -- | Stage all the Package executables in the usr/local/bin -- subdirectory of a temp directory. stageExesInDir :: Build e m => ImageDockerOpts -> Path Abs Dir -> m () stageExesInDir opts dir = do srcBinPath <- fmap ( $(mkRelDir "bin")) installationRootLocal let destBinPath = dir $(mkRelDir "usr/local/bin") ensureDir destBinPath case imgDockerExecutables opts of Nothing -> copyDirRecur srcBinPath destBinPath Just exes -> forM_ exes (\exe -> do exeRelFile <- parseRelFile exe copyFile (srcBinPath exeRelFile) (destBinPath exeRelFile)) -- | Add any additional files into the temp directory, respecting the -- (Source, Destination) mapping. syncAddContentToDir :: Build e m => ImageDockerOpts -> Path Abs Dir -> m () syncAddContentToDir opts dir = do bconfig <- asks getBuildConfig let imgAdd = imgDockerAdd opts forM_ (Map.toList imgAdd) (\(source,dest) -> do sourcePath <- resolveDir (bcRoot bconfig) source destPath <- parseAbsDir dest let destFullPath = dir dropRoot destPath ensureDir destFullPath copyDirRecur sourcePath destFullPath) -- | Derive an image name from the project directory. imageName :: Path Abs Dir -> String imageName = map toLower . toFilePathNoTrailingSep . dirname -- | Create a general purpose docker image from the temporary -- directory of executables & static content. createDockerImage :: Assemble e m => ImageDockerOpts -> Path Abs Dir -> m () createDockerImage dockerConfig dir = do menv <- getMinimalEnvOverride case imgDockerBase dockerConfig of Nothing -> throwM StackImageDockerBaseUnspecifiedException Just base -> do liftIO (writeFile (toFilePath (dir $(mkRelFile "Dockerfile"))) (unlines ["FROM " ++ base, "ADD ./ /"])) let args = [ "build" , "-t" , fromMaybe (imageName (parent . parent . parent $ dir)) (imgDockerImageName dockerConfig) , toFilePathNoTrailingSep dir] callProcess (Cmd Nothing "docker" menv args) -- | Extend the general purpose docker image with entrypoints (if specified). extendDockerImageWithEntrypoint :: Assemble e m => ImageDockerOpts -> Path Abs Dir -> m () extendDockerImageWithEntrypoint dockerConfig dir = do menv <- getMinimalEnvOverride let dockerImageName = fromMaybe (imageName (parent . parent . parent $ dir)) (imgDockerImageName dockerConfig) let imgEntrypoints = imgDockerEntrypoints dockerConfig case imgEntrypoints of Nothing -> return () Just eps -> forM_ eps (\ep -> do liftIO (writeFile (toFilePath (dir $(mkRelFile "Dockerfile"))) (unlines [ "FROM " ++ dockerImageName , "ENTRYPOINT [\"/usr/local/bin/" ++ ep ++ "\"]" , "CMD []"])) callProcess (Cmd Nothing "docker" menv [ "build" , "-t" , dockerImageName ++ "-" ++ ep , toFilePathNoTrailingSep dir])) -- | Fail with friendly error if project root not set. fromMaybeProjectRoot :: Maybe (Path Abs Dir) -> Path Abs Dir fromMaybeProjectRoot = fromMaybe (throw StackImageCannotDetermineProjectRootException) -- | The command name for dealing with images. imgCmdName :: String imgCmdName = "image" -- | The command name for building a docker container. imgDockerCmdName :: String imgDockerCmdName = "container" -- | Convert image opts monoid to image options. imgOptsFromMonoid :: ImageOptsMonoid -> ImageOpts imgOptsFromMonoid ImageOptsMonoid{..} = ImageOpts { imgDockers = imgMonoidDockers } -- | Stack image exceptions. data StackImageException = StackImageDockerBaseUnspecifiedException -- ^ Unspecified parent docker -- container makes building -- impossible | StackImageCannotDetermineProjectRootException -- ^ Can't determine the -- project root (where to -- put image sandbox). deriving (Typeable) instance Exception StackImageException instance Show StackImageException where show StackImageDockerBaseUnspecifiedException = "You must specify a base docker image on which to place your haskell executables." show StackImageCannotDetermineProjectRootException = "Stack was unable to determine the project root in order to build a container." stack-1.1.2/src/Stack/Init.hs0000644000000000000000000005506712717707441014130 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Stack.Init ( initProject , InitOpts (..) ) where import Control.Exception (assert) import Control.Exception.Enclosed (catchAny) import Control.Monad import Control.Monad.Catch (MonadMask, throwM) import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Trans.Control (MonadBaseControl) import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as L import qualified Data.Foldable as F import Data.Function (on) import qualified Data.HashMap.Strict as HM import qualified Data.IntMap as IntMap import Data.List ( intercalate, intersect , maximumBy) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe import Data.Monoid import qualified Data.Text as T import qualified Data.Yaml as Yaml import qualified Distribution.PackageDescription as C import qualified Distribution.Text as C import qualified Distribution.Version as C import Network.HTTP.Client.Conduit (HasHttpManager) import Path import Path.IO import qualified Paths_stack as Meta import Stack.BuildPlan import Stack.Config (getSnapshots, makeConcreteResolver) import Stack.Constants import Stack.Solver import Stack.Types import Stack.Types.Internal (HasLogLevel, HasReExec, HasTerminal) import qualified System.FilePath as FP -- | Generate stack.yaml initProject :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m , MonadReader env m, HasConfig env , HasGHCVariant env , HasHttpManager env , HasLogLevel env , HasReExec env , HasTerminal env) => WhichSolverCmd -> Path Abs Dir -> InitOpts -> Maybe AbstractResolver -> m () initProject whichCmd currDir initOpts mresolver = do let dest = currDir stackDotYaml reldest <- toFilePath `liftM` makeRelativeToCurrentDir dest exists <- doesFileExist dest when (not (forceOverwrite initOpts) && exists) $ do error ("Stack configuration file " <> reldest <> " exists, use 'stack solver' to fix the existing config file or \ \'--force' to overwrite it.") dirs <- mapM (resolveDir' . T.unpack) (searchDirs initOpts) let noPkgMsg = "In order to init, you should have an existing .cabal \ \file. Please try \"stack new\" instead." find = findCabalFiles (includeSubDirs initOpts) dirs' = if null dirs then [currDir] else dirs $logInfo "Looking for .cabal or package.yaml files to use to init the project." cabalfps <- liftM concat $ mapM find dirs' (bundle, dupPkgs) <- cabalPackagesCheck cabalfps noPkgMsg Nothing (r, flags, extraDeps, rbundle) <- getDefaultResolver whichCmd dest initOpts mresolver bundle let ignored = Map.difference bundle rbundle dupPkgMsg | (dupPkgs /= []) = "Warning (added by new or init): Some packages were found to \ \have names conflicting with others and have been commented \ \out in the packages section.\n" | otherwise = "" missingPkgMsg | (Map.size ignored > 0) = "Warning (added by new or init): Some packages were found to \ \be incompatible with the resolver and have been left commented \ \out in the packages section.\n" | otherwise = "" extraDepMsg | (Map.size extraDeps > 0) = "Warning (added by new or init): Specified resolver could not \ \satisfy all dependencies. Some external packages have been \ \added as dependencies.\n" | otherwise = "" makeUserMsg msgs = let msg = concat msgs in if msg /= "" then msg <> "You can suppress this message by removing it from \ \stack.yaml\n" else "" userMsg = makeUserMsg [dupPkgMsg, missingPkgMsg, extraDepMsg] gpds = Map.elems $ fmap snd rbundle p = Project { projectUserMsg = if userMsg == "" then Nothing else Just userMsg , projectPackages = pkgs , projectExtraDeps = extraDeps , projectFlags = PackageFlags (removeSrcPkgDefaultFlags gpds flags) , projectResolver = r , projectCompiler = Nothing , projectExtraPackageDBs = [] } makeRelDir dir = case stripDir currDir dir of Nothing | currDir == dir -> "." | otherwise -> assert False $ toFilePath dir Just rel -> toFilePath rel makeRel = fmap toFilePath . makeRelativeToCurrentDir pkgs = map toPkg $ Map.elems (fmap (parent . fst) rbundle) toPkg dir = PackageEntry { peExtraDep = False , peLocation = PLFilePath $ makeRelDir dir , peSubdirs = [] } indent t = T.unlines $ fmap (" " <>) (T.lines t) $logInfo $ "Initialising configuration using resolver: " <> resolverName r $logInfo $ "Total number of user packages considered: " <> (T.pack $ show $ (Map.size bundle + length dupPkgs)) when (dupPkgs /= []) $ do $logWarn $ "Warning! Ignoring " <> (T.pack $ show $ length dupPkgs) <> " duplicate packages:" rels <- mapM makeRel dupPkgs $logWarn $ indent $ showItems rels when (Map.size ignored > 0) $ do $logWarn $ "Warning! Ignoring " <> (T.pack $ show $ Map.size ignored) <> " packages due to dependency conflicts:" rels <- mapM makeRel (Map.elems (fmap fst ignored)) $logWarn $ indent $ showItems $ rels when (Map.size extraDeps > 0) $ do $logWarn $ "Warning! " <> (T.pack $ show $ Map.size extraDeps) <> " external dependencies were added." $logInfo $ (if exists then "Overwriting existing configuration file: " else "Writing configuration to file: ") <> T.pack reldest liftIO $ L.writeFile (toFilePath dest) $ B.toLazyByteString $ renderStackYaml p (Map.elems $ fmap (makeRelDir . parent . fst) ignored) (map (makeRelDir . parent) dupPkgs) $logInfo "All done." -- | Render a stack.yaml file with comments, see: -- https://github.com/commercialhaskell/stack/issues/226 renderStackYaml :: Project -> [FilePath] -> [FilePath] -> B.Builder renderStackYaml p ignoredPackages dupPackages = case Yaml.toJSON p of Yaml.Object o -> renderObject o _ -> assert False $ B.byteString $ Yaml.encode p where renderObject o = B.byteString headerHelp <> B.byteString "\n\n" <> F.foldMap (goComment o) comments <> goOthers (o `HM.difference` HM.fromList comments) <> B.byteString footerHelp goComment o (name, comment) = case HM.lookup name o of Nothing -> assert (name == "user-message") mempty Just v -> B.byteString comment <> B.byteString "\n" <> B.byteString (Yaml.encode $ Yaml.object [(name, v)]) <> if (name == "packages") then commentedPackages else "" <> B.byteString "\n" commentHelp = BC.pack . intercalate "\n" . map ("# " ++) commentedPackages = let ignoredComment = commentHelp [ "The following packages have been ignored due to incompatibility with the" , "resolver compiler, dependency conflicts with other packages" , "or unsatisfied dependencies." ] dupComment = commentHelp [ "The following packages have been ignored due to package name conflict " , "with other packages." ] in commentPackages ignoredComment ignoredPackages <> commentPackages dupComment dupPackages commentPackages comment pkgs | pkgs /= [] = B.byteString comment <> B.byteString "\n" <> (B.byteString $ BC.pack $ concat $ (map (\x -> "#- " ++ x ++ "\n") pkgs) ++ ["\n"]) | otherwise = "" goOthers o | HM.null o = mempty | otherwise = assert False $ B.byteString $ Yaml.encode o -- Per Section Help comments = [ ("user-message" , userMsgHelp) , ("resolver" , resolverHelp) , ("packages" , packageHelp) , ("extra-deps" , "# Dependency packages to be pulled from upstream that are not in the resolver\n# (e.g., acme-missiles-0.3)") , ("flags" , "# Override default flag values for local packages and extra-deps") , ("extra-package-dbs", "# Extra package databases containing global packages") ] -- Help strings headerHelp = commentHelp [ "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:" , "http://docs.haskellstack.org/en/stable/yaml_configuration/" ] resolverHelp = commentHelp [ "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\"" ] userMsgHelp = commentHelp [ "A warning or info to be displayed to the user on config load." ] packageHelp = commentHelp [ "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." ] footerHelp = let major = toCabalVersion $ toMajorVersion $ fromCabalVersion Meta.version in commentHelp [ "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: \"" ++ C.display (C.orLaterVersion major) ++ "\"" , "" , "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" ] getSnapshots' :: (MonadIO m, MonadMask m, MonadReader env m, HasConfig env, HasHttpManager env, MonadLogger m, MonadBaseControl IO m) => m Snapshots getSnapshots' = getSnapshots `catchAny` \e -> do $logError $ "Unable to download snapshot list, and therefore could " <> "not generate a stack.yaml file automatically" $logError $ "This sometimes happens due to missing Certificate Authorities " <> "on your system. For more information, see:" $logError "" $logError " https://github.com/commercialhaskell/stack/issues/234" $logError "" $logError "You can try again, or create your stack.yaml file by hand. See:" $logError "" $logError " http://docs.haskellstack.org/en/stable/yaml_configuration/" $logError "" $logError $ "Exception was: " <> T.pack (show e) error "" -- | Get the default resolver value getDefaultResolver :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m , MonadReader env m, HasConfig env , HasGHCVariant env , HasHttpManager env , HasLogLevel env , HasReExec env , HasTerminal env) => WhichSolverCmd -> Path Abs File -- ^ stack.yaml -> InitOpts -> Maybe AbstractResolver -> Map PackageName (Path Abs File, C.GenericPackageDescription) -- ^ Src package name: cabal dir, cabal package description -> m ( Resolver , Map PackageName (Map FlagName Bool) , Map PackageName Version , Map PackageName (Path Abs File, C.GenericPackageDescription)) -- ^ ( Resolver -- , Flags for src packages and extra deps -- , Extra dependencies -- , Src packages actually considered) getDefaultResolver whichCmd stackYaml initOpts mresolver bundle = maybe selectSnapResolver makeConcreteResolver mresolver >>= getWorkingResolverPlan whichCmd stackYaml initOpts bundle where -- TODO support selecting best across regular and custom snapshots selectSnapResolver = do let gpds = Map.elems (fmap snd bundle) snaps <- fmap getRecommendedSnapshots getSnapshots' (s, r) <- selectBestSnapshot gpds snaps case r of BuildPlanCheckFail {} | not (omitPackages initOpts) -> throwM (NoMatchingSnapshot whichCmd snaps) _ -> return $ ResolverSnapshot s getWorkingResolverPlan :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m , MonadReader env m, HasConfig env , HasGHCVariant env , HasHttpManager env , HasLogLevel env , HasReExec env , HasTerminal env) => WhichSolverCmd -> Path Abs File -- ^ stack.yaml -> InitOpts -> Map PackageName (Path Abs File, C.GenericPackageDescription) -- ^ Src package name: cabal dir, cabal package description -> Resolver -> m ( Resolver , Map PackageName (Map FlagName Bool) , Map PackageName Version , Map PackageName (Path Abs File, C.GenericPackageDescription)) -- ^ ( Resolver -- , Flags for src packages and extra deps -- , Extra dependencies -- , Src packages actually considered) getWorkingResolverPlan whichCmd stackYaml initOpts bundle resolver = do $logInfo $ "Selected resolver: " <> resolverName resolver go bundle where go info = do eres <- checkBundleResolver whichCmd stackYaml initOpts info resolver -- if some packages failed try again using the rest case eres of Right (f, edeps)-> return (resolver, f, edeps, info) Left ignored | Map.null available -> do $logWarn "*** Could not find a working plan for any of \ \the user packages.\nProceeding to create a \ \config anyway." return (resolver, Map.empty, Map.empty, Map.empty) | otherwise -> do when ((Map.size available) == (Map.size info)) $ error "Bug: No packages to ignore" if length ignored > 1 then do $logWarn "*** Ignoring packages:" $logWarn $ indent $ showItems ignored else $logWarn $ "*** Ignoring package: " <> (T.pack $ packageNameString (head ignored)) go available where indent t = T.unlines $ fmap (" " <>) (T.lines t) isAvailable k _ = not (k `elem` ignored) available = Map.filterWithKey isAvailable info checkBundleResolver :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m , MonadReader env m, HasConfig env , HasGHCVariant env , HasHttpManager env , HasLogLevel env , HasReExec env , HasTerminal env) => WhichSolverCmd -> Path Abs File -- ^ stack.yaml -> InitOpts -> Map PackageName (Path Abs File, C.GenericPackageDescription) -- ^ Src package name: cabal dir, cabal package description -> Resolver -> m (Either [PackageName] ( Map PackageName (Map FlagName Bool) , Map PackageName Version)) checkBundleResolver whichCmd stackYaml initOpts bundle resolver = do result <- checkResolverSpec gpds Nothing resolver case result of BuildPlanCheckOk f -> return $ Right (f, Map.empty) BuildPlanCheckPartial f e | needSolver resolver initOpts -> do warnPartial result solve f | omitPackages initOpts -> do warnPartial result $logWarn "*** Omitting packages with unsatisfied dependencies" return $ Left $ failedUserPkgs e | otherwise -> throwM $ ResolverPartial whichCmd resolver (show result) BuildPlanCheckFail _ e _ | omitPackages initOpts -> do $logWarn $ "*** Resolver compiler mismatch: " <> resolverName resolver $logWarn $ indent $ T.pack $ show result return $ Left $ failedUserPkgs e | otherwise -> throwM $ ResolverMismatch whichCmd resolver (show result) where indent t = T.unlines $ fmap (" " <>) (T.lines t) warnPartial res = do $logWarn $ "*** Resolver " <> resolverName resolver <> " will need external packages: " $logWarn $ indent $ T.pack $ show res failedUserPkgs e = Map.keys $ Map.unions (Map.elems (fmap deNeededBy e)) gpds = Map.elems (fmap snd bundle) solve flags = do let cabalDirs = map parent (Map.elems (fmap fst bundle)) srcConstraints = mergeConstraints (gpdPackages gpds) flags eresult <- solveResolverSpec stackYaml cabalDirs (resolver, srcConstraints, Map.empty) case eresult of Right (src, ext) -> return $ Right (fmap snd (Map.union src ext), fmap fst ext) Left packages | omitPackages initOpts, srcpkgs /= []-> do pkg <- findOneIndependent srcpkgs flags return $ Left [pkg] | otherwise -> throwM (SolverGiveUp giveUpMsg) where srcpkgs = intersect (Map.keys bundle) packages -- among a list of packages find one on which none among the rest of the -- packages depend. This package is a good candidate to be removed from -- the list of packages when there is conflict in dependencies among this -- set of packages. findOneIndependent packages flags = do platform <- asks (configPlatform . getConfig) (compiler, _) <- getResolverConstraints stackYaml resolver let getGpd pkg = snd (fromJust (Map.lookup pkg bundle)) getFlags pkg = fromJust (Map.lookup pkg flags) deps pkg = gpdPackageDeps (getGpd pkg) compiler platform (getFlags pkg) allDeps = concat $ map (Map.keys . deps) packages isIndependent pkg = not $ pkg `elem` allDeps -- prefer to reject packages in deeper directories path pkg = fst (fromJust (Map.lookup pkg bundle)) pathlen = length . FP.splitPath . toFilePath . path maxPathlen = maximumBy (compare `on` pathlen) return $ maxPathlen (filter isIndependent packages) giveUpMsg = concat [ " - Use '--omit-packages to exclude conflicting package(s).\n" , " - Tweak the generated " , toFilePath stackDotYaml <> " and then run 'stack solver':\n" , " - Add any missing remote packages.\n" , " - Add extra dependencies to guide solver.\n" , " - Update external packages with 'stack update' and try again.\n" ] needSolver _ (InitOpts {useSolver = True}) = True needSolver (ResolverCompiler _) _ = True needSolver _ _ = False getRecommendedSnapshots :: Snapshots -> (NonEmpty SnapName) getRecommendedSnapshots snapshots = -- in order - Latest LTS, Latest Nightly, all LTS most recent first case NonEmpty.nonEmpty ltss of Just (mostRecent :| older) -> mostRecent :| (nightly : older) Nothing -> nightly :| [] where ltss = map (uncurry LTS) (IntMap.toDescList $ snapshotsLts snapshots) nightly = Nightly (snapshotsNightly snapshots) data InitOpts = InitOpts { searchDirs :: ![T.Text] -- ^ List of sub directories to search for .cabal files , useSolver :: Bool -- ^ Use solver to determine required external dependencies , omitPackages :: Bool -- ^ Exclude conflicting or incompatible user packages , forceOverwrite :: Bool -- ^ Overwrite existing stack.yaml , includeSubDirs :: Bool -- ^ If True, include all .cabal files found in any sub directories } stack-1.1.2/src/Stack/New.hs0000644000000000000000000004401212717707441013742 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- | Create new a new project directory populated with a basic working -- project. module Stack.New ( new , NewOpts(..) , defaultTemplateName , templateNameArgument , getTemplates , TemplateName , listTemplates) where import Control.Monad import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader import Control.Monad.Trans.Writer.Strict import Data.Aeson import Data.Aeson.Types import qualified Data.ByteString.Lazy as LB import qualified Data.ByteString.Lazy.Char8 as L8 import Data.Conduit import Data.Foldable (asum) import qualified Data.HashMap.Strict as HM import Data.List import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe) import Data.Maybe.Extra (mapMaybeM) import Data.Monoid import Data.Set (Set) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T import qualified Data.Text.Lazy as LT import Data.Time.Calendar import Data.Time.Clock import Data.Typeable import qualified Data.Yaml as Yaml import Network.HTTP.Client.Conduit hiding (path) import Network.HTTP.Download import Network.HTTP.Types.Status import Path import Path.IO import Prelude import Stack.Constants import Stack.Types import Stack.Types.TemplateName import System.Process.Run import Text.Hastache import Text.Hastache.Context import Text.Printf import Text.ProjectTemplate -------------------------------------------------------------------------------- -- Main project creation -- | Options for creating a new project. data NewOpts = NewOpts { newOptsProjectName :: PackageName -- ^ Name of the project to create. , newOptsCreateBare :: Bool -- ^ Whether to create the project without a directory. , newOptsTemplate :: Maybe TemplateName -- ^ Name of the template to use. , newOptsNonceParams :: Map Text Text -- ^ Nonce parameters specified just for this invocation. } -- | Create a new project with the given options. new :: (HasConfig r, MonadReader r m, MonadLogger m, MonadCatch m, MonadIO m, HasHttpManager r) => NewOpts -> Bool -> m (Path Abs Dir) new opts forceOverwrite = do pwd <- getCurrentDir absDir <- if bare then return pwd else do relDir <- parseRelDir (packageNameString project) liftM (pwd ) (return relDir) exists <- doesDirExist absDir configTemplate <- asks (configDefaultTemplate . getConfig) let template = fromMaybe defaultTemplateName $ asum [ cliOptionTemplate , configTemplate ] if exists && not bare then throwM (AlreadyExists absDir) else do templateText <- loadTemplate template (logUsing absDir template) files <- applyTemplate project template (newOptsNonceParams opts) absDir templateText when (not forceOverwrite && bare) $ checkForOverwrite (M.keys files) writeTemplateFiles files runTemplateInits absDir return absDir where cliOptionTemplate = newOptsTemplate opts project = newOptsProjectName opts bare = newOptsCreateBare opts logUsing absDir template templateFrom = let loading = case templateFrom of LocalTemp -> "Loading local" RemoteTemp -> "Downloading" in $logInfo (loading <> " template \"" <> templateName template <> "\" to create project \"" <> packageNameText project <> "\" in " <> if bare then "the current directory" else T.pack (toFilePath (dirname absDir)) <> " ...") data TemplateFrom = LocalTemp | RemoteTemp -- | Download and read in a template's text content. loadTemplate :: forall m r. (HasConfig r, HasHttpManager r, MonadReader r m, MonadIO m, MonadThrow m, MonadCatch m, MonadLogger m) => TemplateName -> (TemplateFrom -> m ()) -> m Text loadTemplate name logIt = do templateDir <- asks (templatesDir . getConfig) case templatePath name of AbsPath absFile -> logIt LocalTemp >> loadLocalFile absFile UrlPath s -> do let req = fromMaybe (error "impossible happened: already valid \ \URL couldn't be parsed") (parseUrl s) rel = fromMaybe backupUrlRelPath (parseRelFile s) downloadTemplate req (templateDir rel) RelPath relFile -> catch (do f <- loadLocalFile relFile logIt LocalTemp return f) (\(e :: NewException) -> case relRequest relFile of Just req -> downloadTemplate req (templateDir relFile) Nothing -> throwM e ) where loadLocalFile :: Path b File -> m Text loadLocalFile path = do $logDebug ("Opening local template: \"" <> T.pack (toFilePath path) <> "\"") exists <- doesFileExist path if exists then liftIO (T.readFile (toFilePath path)) else throwM (FailedToLoadTemplate name (toFilePath path)) relRequest :: MonadThrow n => Path Rel File -> n Request relRequest rel = parseUrl (defaultTemplateUrl <> "/" <> toFilePath rel) downloadTemplate :: Request -> Path Abs File -> m Text downloadTemplate req path = do logIt RemoteTemp _ <- catch (redownload req path) (throwM . FailedToDownloadTemplate name) loadLocalFile path backupUrlRelPath = $(mkRelFile "downloaded.template.file.hsfiles") -- | Apply and unpack a template into a directory. applyTemplate :: (MonadIO m, MonadCatch m, MonadReader r m, HasConfig r, MonadLogger m) => PackageName -> TemplateName -> Map Text Text -> Path Abs Dir -> Text -> m (Map (Path Abs File) LB.ByteString) applyTemplate project template nonceParams dir templateText = do config <- asks getConfig currentYear <- do now <- liftIO getCurrentTime (year, _, _) <- return $ toGregorian . utctDay $ now return $ T.pack . show $ year let context = M.union (M.union nonceParams extraParams) configParams where extraParams = M.fromList [ ("name", packageNameText project) , ("year", currentYear) ] configParams = configTemplateParams config (applied,missingKeys) <- runWriterT (hastacheStr defaultConfig { muEscapeFunc = id } templateText (mkStrContextM (contextFunction context))) unless (S.null missingKeys) ($logInfo ("\n" <> T.pack (show (MissingParameters project template missingKeys (configUserConfigPath config))) <> "\n")) files :: Map FilePath LB.ByteString <- catch (execWriterT $ yield (T.encodeUtf8 (LT.toStrict applied)) $$ unpackTemplate receiveMem id ) (\(e :: ProjectTemplateException) -> throwM (InvalidTemplate template (show e))) when (M.null files) $ throwM (InvalidTemplate template "Template does not contain any files") let isPkgSpec f = ".cabal" `isSuffixOf` f || f == "package.yaml" unless (any isPkgSpec . M.keys $ files) $ throwM (InvalidTemplate template "Template does not contain a .cabal \ \or package.yaml file") liftM M.fromList (mapM (\(fp,bytes) -> do path <- parseRelFile fp return (dir path, bytes)) (M.toList files)) where -- | Does a lookup in the context and returns a moustache value, -- on the side, writes out a set of keys that were requested but -- not found. contextFunction :: Monad m => Map Text Text -> String -> WriterT (Set String) m (MuType (WriterT (Set String) m)) contextFunction context key = case M.lookup (T.pack key) context of Nothing -> do tell (S.singleton key) return MuNothing Just value -> return (MuVariable value) -- | Check if we're going to overwrite any existing files. checkForOverwrite :: (MonadIO m, MonadThrow m) => [Path Abs File] -> m () checkForOverwrite files = do overwrites <- filterM doesFileExist files unless (null overwrites) $ throwM (AttemptedOverwrites overwrites) -- | Write files to the new project directory. writeTemplateFiles :: MonadIO m => Map (Path Abs File) LB.ByteString -> m () writeTemplateFiles files = forM_ (M.toList files) (\(fp,bytes) -> do ensureDir (parent fp) liftIO (LB.writeFile (toFilePath fp) bytes)) -- | Run any initialization functions, such as Git. runTemplateInits :: (MonadIO m, MonadReader r m, HasConfig r, MonadLogger m, MonadCatch m) => Path Abs Dir -> m () runTemplateInits dir = do menv <- getMinimalEnvOverride config <- asks getConfig case configScmInit config of Nothing -> return () Just Git -> catch (callProcess $ Cmd (Just dir) "git" menv ["init"]) (\(_ :: ProcessExitedUnsuccessfully) -> $logInfo "git init failed to run, ignoring ...") -- | Display the set of templates accompanied with description if available. listTemplates :: (MonadIO m, MonadReader r m, HasHttpManager r, MonadCatch m) => m () listTemplates = do templates <- getTemplates templateInfo <- getTemplateInfo if not . M.null $ templateInfo then do let keySizes = map (T.length . templateName) $ S.toList templates padWidth = show $ maximum keySizes outputfmt = "%-" <> padWidth <> "s %s\n" headerfmt = "%-" <> padWidth <> "s %s\n" liftIO $ printf headerfmt ("Template"::String) ("Description"::String) forM_ (S.toList templates) (\x -> do let name = templateName x desc = fromMaybe "" $ liftM (mappend "- ") (M.lookup name templateInfo >>= description) liftIO $ printf outputfmt (T.unpack name) (T.unpack desc)) else mapM_ (liftIO . T.putStrLn . templateName) (S.toList templates) -- | Get the set of templates. getTemplates :: (MonadIO m, MonadReader r m, HasHttpManager r, MonadCatch m) => m (Set TemplateName) getTemplates = do req <- liftM addHeaders (parseUrl defaultTemplatesList) resp <- catch (httpLbs req) (throwM . FailedToDownloadTemplates) case statusCode (responseStatus resp) of 200 -> case eitherDecode (responseBody resp) >>= parseEither parseTemplateSet of Left err -> throwM (BadTemplatesJSON err (responseBody resp)) Right value -> return value code -> throwM (BadTemplatesResponse code) getTemplateInfo :: (MonadIO m, MonadReader r m, HasHttpManager r, MonadCatch m) => m (Map Text TemplateInfo) getTemplateInfo = do req <- liftM addHeaders (parseUrl defaultTemplateInfoUrl) resp <- catch (liftM Right $ httpLbs req) (\(ex :: HttpException) -> return . Left $ "Failed to download template info. The HTTP error was: " <> show ex) case resp >>= is200 of Left err -> do liftIO . putStrLn $ err return M.empty Right resp' -> case Yaml.decodeEither (LB.toStrict $ responseBody resp') :: Either String Object of Left err -> throwM $ BadTemplateInfo err Right o -> return (M.mapMaybe (Yaml.parseMaybe Yaml.parseJSON) (M.fromList . HM.toList $ o) :: Map Text TemplateInfo) where is200 resp = if statusCode (responseStatus resp) == 200 then return resp else Left $ "Unexpected status code while retrieving templates info: " <> show (statusCode $ responseStatus resp) addHeaders :: Request -> Request addHeaders req = req { requestHeaders = [ ("User-Agent", "The Haskell Stack") , ("Accept", "application/vnd.github.v3+json")] <> requestHeaders req } -- | Parser the set of templates from the JSON. parseTemplateSet :: Value -> Parser (Set TemplateName) parseTemplateSet a = do xs <- parseJSON a fmap S.fromList (mapMaybeM parseTemplate xs) where parseTemplate v = do o <- parseJSON v name <- o .: "name" if ".hsfiles" `isSuffixOf` name then case parseTemplateNameFromString name of Left{} -> fail ("Unable to parse template name from " <> name) Right template -> return (Just template) else return Nothing -------------------------------------------------------------------------------- -- Defaults -- | The default template name you can use if you don't have one. defaultTemplateName :: TemplateName defaultTemplateName = $(mkTemplateName "new-template") -- | Default web root URL to download from. defaultTemplateUrl :: String defaultTemplateUrl = "https://raw.githubusercontent.com/commercialhaskell/stack-templates/master" -- | Default web URL to get a yaml file containing template metadata. defaultTemplateInfoUrl :: String defaultTemplateInfoUrl = "https://raw.githubusercontent.com/commercialhaskell/stack-templates/master/template-info.yaml" -- | Default web URL to list the repo contents. defaultTemplatesList :: String defaultTemplatesList = "https://api.github.com/repos/commercialhaskell/stack-templates/contents/" -------------------------------------------------------------------------------- -- Exceptions -- | Exception that might occur when making a new project. data NewException = FailedToLoadTemplate !TemplateName !FilePath | FailedToDownloadTemplate !TemplateName !DownloadException | FailedToDownloadTemplates !HttpException | BadTemplatesResponse !Int | BadTemplatesJSON !String !LB.ByteString | AlreadyExists !(Path Abs Dir) | MissingParameters !PackageName !TemplateName !(Set String) !(Path Abs File) | InvalidTemplate !TemplateName !String | AttemptedOverwrites [Path Abs File] | FailedToDownloadTemplateInfo !HttpException | BadTemplateInfo !String | BadTemplateInfoResponse !Int deriving (Typeable) instance Exception NewException instance Show NewException where show (FailedToLoadTemplate name path) = "Failed to load download template " <> T.unpack (templateName name) <> " from " <> path show (FailedToDownloadTemplate name (RedownloadFailed _ _ resp)) = case statusCode (responseStatus resp) of 404 -> "That template doesn't exist. Run `stack templates' to see a list of available templates." code -> "Failed to download template " <> T.unpack (templateName name) <> ": unknown reason, status code was: " <> show code show (FailedToDownloadTemplate name _) = "Failed to download template " <> T.unpack (templateName name) <> ", reason unknown." show (AlreadyExists path) = "Directory " <> toFilePath path <> " already exists. Aborting." show (FailedToDownloadTemplates ex) = "Failed to download templates. The HTTP error was: " <> show ex show (BadTemplatesResponse code) = "Unexpected status code while retrieving templates list: " <> show code show (BadTemplatesJSON err bytes) = "Github returned some JSON that couldn't be parsed: " <> err <> "\n\n" <> L8.unpack bytes show (MissingParameters name template missingKeys userConfigPath) = intercalate "\n" [ "The following parameters were needed by the template but not provided: " <> intercalate ", " (S.toList missingKeys) , "You can provide them in " <> toFilePath userConfigPath <> ", like this:" , "templates:" , " params:" , intercalate "\n" (map (\key -> " " <> key <> ": value") (S.toList missingKeys)) , "Or you can pass each one as parameters like this:" , "stack new " <> packageNameString name <> " " <> T.unpack (templateName template) <> " " <> unwords (map (\key -> "-p \"" <> key <> ":value\"") (S.toList missingKeys))] show (InvalidTemplate name why) = "The template \"" <> T.unpack (templateName name) <> "\" is invalid and could not be used. " <> "The error was: \"" <> why <> "\"" show (AttemptedOverwrites fps) = "The template would create the following files, but they already exist:\n" <> unlines (map ((" " ++) . toFilePath) fps) <> "Use --force to ignore this, and overwite these files." show (FailedToDownloadTemplateInfo ex) = "Failed to download templates info. The HTTP error was: " <> show ex show (BadTemplateInfo err) = "Template info couldn't be parsed: " <> err show (BadTemplateInfoResponse code) = "Unexpected status code while retrieving templates info: " <> show code stack-1.1.2/src/Stack/Nix.hs0000644000000000000000000001502412706265473013752 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -- | Run commands in a nix-shell module Stack.Nix (reexecWithOptionalShell ,nixCmdName ,nixHelpOptName ) where import Control.Applicative import Control.Arrow ((***)) import Control.Exception (Exception,throw) import Control.Monad hiding (mapM) import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Class (MonadIO,liftIO) import Control.Monad.Logger (MonadLogger,logDebug) import Control.Monad.Reader (MonadReader,asks) import Control.Monad.Trans.Control (MonadBaseControl) import Data.Char (toUpper) import Data.List (intercalate) import Data.Maybe import Data.Monoid import qualified Data.Text as T import Data.Traversable import Data.Typeable (Typeable) import Data.Version (showVersion) import Network.HTTP.Client.Conduit (HasHttpManager) import Path import Path.IO import qualified Paths_stack as Meta import Prelude hiding (mapM) -- Fix redundant import warnings import Stack.Config (makeConcreteResolver) import Stack.Config.Nix (nixCompiler) import Stack.Constants (stackProgName,platformVariantEnvVar) import Stack.Docker (reExecArgName) import Stack.Exec (exec) import Stack.Types import Stack.Types.Internal import System.Environment (lookupEnv,getArgs,getExecutablePath) import System.Process.Read (getEnvOverride) -- | If Nix is enabled, re-runs the currently running OS command in a Nix container. -- Otherwise, runs the inner action. reexecWithOptionalShell :: M env m => Maybe (Path Abs Dir) -> Maybe AbstractResolver -> Maybe CompilerVersion -> IO () -> m () reexecWithOptionalShell mprojectRoot maresolver mcompiler inner = do config <- asks getConfig inShell <- getInShell isReExec <- asks getReExec if nixEnable (configNix config) && not inShell && not isReExec then runShellAndExit mprojectRoot maresolver mcompiler getCmdArgs else liftIO inner where getCmdArgs = do args <- fmap (("--" ++ reExecArgName ++ "=" ++ showVersion Meta.version) :) (liftIO getArgs) exePath <- liftIO getExecutablePath return (exePath, args) runShellAndExit :: M env m => Maybe (Path Abs Dir) -> Maybe AbstractResolver -> Maybe CompilerVersion -> m (String, [String]) -> m () runShellAndExit mprojectRoot maresolver mcompiler getCmdArgs = do config <- asks getConfig mresolver <- mapM makeConcreteResolver maresolver envOverride <- getEnvOverride (configPlatform config) (cmnd,args) <- fmap (escape *** map escape) getCmdArgs mshellFile <- traverse (resolveFile (fromMaybeProjectRoot mprojectRoot)) $ nixInitFile (configNix config) let pkgsInConfig = nixPackages (configNix config) pkgs = pkgsInConfig ++ [nixCompiler config mresolver mcompiler] pureShell = nixPureShell (configNix config) nixopts = case mshellFile of Just fp -> [toFilePath fp] Nothing -> ["-E", T.unpack $ T.intercalate " " $ concat [["with (import {});" ,"runCommand \"myEnv\" {" ,"buildInputs=lib.optional stdenv.isLinux glibcLocales ++ ["],pkgs,["];" ,T.pack platformVariantEnvVar <> "=''nix'';" ,T.pack inShellEnvVar <> "=1;" ,"STACK_IN_NIX_EXTRA_ARGS=''"] , (map (\p -> T.concat ["--extra-lib-dirs=${",p,"}/lib" ," --extra-include-dirs=${",p,"}/include "]) pkgs), ["'' ;" ,"} \"\""]]] -- glibcLocales is necessary on Linux to avoid warnings about GHC being incapable to set the locale. fullArgs = concat [if pureShell then ["--pure"] else [], map T.unpack (nixShellOptions (configNix config)) ,nixopts ,["--run", intercalate " " (cmnd:"$STACK_IN_NIX_EXTRA_ARGS":args)] ] -- Using --run instead of --command so we cannot -- end up in the nix-shell if stack build is Ctrl-C'd $logDebug $ "Using a nix-shell environment " <> (case mshellFile of Just path -> "from file: " <> (T.pack (toFilePath path)) Nothing -> "with nix packages: " <> (T.intercalate ", " pkgs)) exec envOverride "nix-shell" fullArgs -- | Shell-escape quotes inside the string and enclose it in quotes. escape :: String -> String escape str = "'" ++ foldr (\c -> if c == '\'' then ("'\"'\"'"++) else (c:)) "" str ++ "'" -- | Fail with friendly error if project root not set. fromMaybeProjectRoot :: Maybe (Path Abs Dir) -> Path Abs Dir fromMaybeProjectRoot = fromMaybe (throw CannotDetermineProjectRootException) -- | 'True' if we are currently running inside a Nix. getInShell :: (MonadIO m) => m Bool getInShell = liftIO (isJust <$> lookupEnv inShellEnvVar) -- | Environment variable used to indicate stack is running in container. -- although we already have STACK_IN_NIX_EXTRA_ARGS that is set in the same conditions, -- it can happen that STACK_IN_NIX_EXTRA_ARGS is set to empty. inShellEnvVar :: String inShellEnvVar = concat [map toUpper stackProgName,"_IN_NIXSHELL"] -- | Command-line argument for "nix" nixCmdName :: String nixCmdName = "nix" nixHelpOptName :: String nixHelpOptName = nixCmdName ++ "-help" -- | Exceptions thrown by "Stack.Nix". data StackNixException = CannotDetermineProjectRootException -- ^ Can't determine the project root (location of the shell file if any). deriving (Typeable) instance Exception StackNixException instance Show StackNixException where show CannotDetermineProjectRootException = "Cannot determine project root directory." type M env m = (MonadIO m ,MonadReader env m ,MonadLogger m ,MonadBaseControl IO m ,MonadMask m ,HasConfig env ,HasTerminal env ,HasReExec env ,HasHttpManager env ) stack-1.1.2/src/Stack/Options.hs0000644000000000000000000011210612717707441014644 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} module Stack.Options (BuildCommand(..) ,GlobalOptsContext(..) ,benchOptsParser ,buildOptsParser ,cleanOptsParser ,configCmdSetParser ,configOptsParser ,dockerOptsParser ,dockerCleanupOptsParser ,dotOptsParser ,execOptsParser ,evalOptsParser ,globalOptsParser ,initOptsParser ,newOptsParser ,nixOptsParser ,logLevelOptsParser ,ghciOptsParser ,solverOptsParser ,testOptsParser ,haddockOptsParser ,hpcReportOptsParser ,pvpBoundsOption ,globalOptsFromMonoid ,splitObjsWarning ) where import Control.Monad.Logger (LogLevel (..)) import Data.Char (isSpace, toLower, toUpper) import Data.List (intercalate) import Data.List.Split (splitOn) import qualified Data.Map as Map import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe import Data.Monoid.Extra import qualified Data.Set as Set import qualified Data.Text as T import Data.Text.Read (decimal) import Distribution.Version (anyVersion) import Options.Applicative import Options.Applicative.Args import Options.Applicative.Builder.Extra import Options.Applicative.Types (fromM, oneM, readerAsk) import Path import Stack.Build (splitObjsWarning) import Stack.Clean (CleanOpts (..)) import Stack.Config (packagesParser) import Stack.ConfigCmd import Stack.Constants import Stack.Coverage (HpcReportOpts (..)) import Stack.Docker import qualified Stack.Docker as Docker import Stack.Dot import Stack.Ghci (GhciOpts (..)) import Stack.Init import Stack.New import Stack.Nix import Stack.Types import Stack.Types.TemplateName -- | Allows adjust global options depending on their context -- Note: This was being used to remove ambibuity between the local and global -- implementation of stack init --resolver option. Now that stack init has no -- local --resolver this is not being used anymore but the code is kept for any -- similar future use cases. data GlobalOptsContext = OuterGlobalOpts -- ^ Global options before subcommand name | OtherCmdGlobalOpts -- ^ Global options following any other subcommand | BuildCmdGlobalOpts deriving (Show, Eq) -- | Parser for bench arguments. -- FIXME hiding options benchOptsParser :: Bool -> Parser BenchmarkOptsMonoid benchOptsParser hide0 = BenchmarkOptsMonoid <$> optionalFirst (strOption (long "benchmark-arguments" <> metavar "BENCH_ARGS" <> help ("Forward BENCH_ARGS to the benchmark suite. " <> "Supports templates from `cabal bench`") <> hide)) <*> optionalFirst (switch (long "no-run-benchmarks" <> help "Disable running of benchmarks. (Benchmarks will still be built.)" <> hide)) where hide = hideMods hide0 -- | Parser for CLI-only build arguments buildOptsParser :: BuildCommand -> Parser BuildOptsCLI buildOptsParser cmd = BuildOptsCLI <$> many (textArgument (metavar "TARGET" <> help "If none specified, use all packages")) <*> switch (long "dry-run" <> help "Don't build anything, just prepare to") <*> ((\x y z -> concat [x, y, z]) <$> flag [] ["-Wall", "-Werror"] (long "pedantic" <> help "Turn on -Wall and -Werror") <*> flag [] ["-O0"] (long "fast" <> help "Turn off optimizations (-O0)") <*> many (textOption (long "ghc-options" <> metavar "OPTION" <> help "Additional options passed to GHC"))) <*> (Map.unionsWith Map.union <$> many (option readFlag (long "flag" <> metavar "PACKAGE:[-]FLAG" <> help ("Override flags set in stack.yaml " <> "(applies to local packages and extra-deps)")))) <*> (flag' BSOnlyDependencies (long "dependencies-only" <> help "A synonym for --only-dependencies") <|> flag' BSOnlySnapshot (long "only-snapshot" <> help "Only build packages for the snapshot database, not the local database") <|> flag' BSOnlyDependencies (long "only-dependencies" <> help "Only build packages that are dependencies of targets on the command line") <|> pure BSAll) <*> (flag' FileWatch (long "file-watch" <> help "Watch for changes in local files and automatically rebuild. Ignores files in VCS boring/ignore file") <|> flag' FileWatchPoll (long "file-watch-poll" <> help "Like --file-watch, but polling the filesystem instead of using events") <|> pure NoFileWatch) <*> many (cmdOption (long "exec" <> metavar "CMD [ARGS]" <> help "Command and arguments to run after a successful build")) <*> switch (long "only-configure" <> help "Only perform the configure step, not any builds. Intended for tool usage, may break when used on multiple packages at once!") <*> pure cmd -- | Parser for package:[-]flag readFlag :: ReadM (Map (Maybe PackageName) (Map FlagName Bool)) readFlag = do s <- readerAsk case break (== ':') s of (pn, ':':mflag) -> do pn' <- case parsePackageNameFromString pn of Nothing | pn == "*" -> return Nothing | otherwise -> readerError $ "Invalid package name: " ++ pn Just x -> return $ Just x let (b, flagS) = case mflag of '-':x -> (False, x) _ -> (True, mflag) flagN <- case parseFlagNameFromString flagS of Nothing -> readerError $ "Invalid flag name: " ++ flagS Just x -> return x return $ Map.singleton pn' $ Map.singleton flagN b _ -> readerError "Must have a colon" -- | Command-line parser for the clean command. cleanOptsParser :: Parser CleanOpts cleanOptsParser = CleanShallow <$> packages <|> doFullClean where packages = many (packageNameArgument (metavar "PACKAGE" <> help "If none specified, clean all local packages")) doFullClean = flag' CleanFull (long "full" <> help "Delete all work directories (.stack-work by default) in the project") -- | Command-line arguments parser for configuration. configOptsParser :: GlobalOptsContext -> Parser ConfigMonoid configOptsParser hide0 = (\stackRoot workDir buildOpts dockerOpts nixOpts systemGHC installGHC arch os ghcVariant jobs includes libs skipGHCCheck skipMsys localBin modifyCodePage allowDifferentUser -> mempty { configMonoidStackRoot = stackRoot , configMonoidWorkDir = workDir , configMonoidBuildOpts = buildOpts , configMonoidDockerOpts = dockerOpts , configMonoidNixOpts = nixOpts , configMonoidSystemGHC = systemGHC , configMonoidInstallGHC = installGHC , configMonoidSkipGHCCheck = skipGHCCheck , configMonoidArch = arch , configMonoidOS = os , configMonoidGHCVariant = ghcVariant , configMonoidJobs = jobs , configMonoidExtraIncludeDirs = includes , configMonoidExtraLibDirs = libs , configMonoidSkipMsys = skipMsys , configMonoidLocalBinPath = localBin , configMonoidModifyCodePage = modifyCodePage , configMonoidAllowDifferentUser = allowDifferentUser }) <$> optionalFirst (option readAbsDir ( long stackRootOptionName <> metavar (map toUpper stackRootOptionName) <> help ("Absolute path to the global stack root directory " ++ "(Overrides any STACK_ROOT environment variable)") <> hide )) <*> optionalFirst (strOption ( long "work-dir" <> metavar "WORK-DIR" <> help "Override work directory (default: .stack-work)" <> hide )) <*> buildOptsMonoidParser (hide0 /= BuildCmdGlobalOpts) <*> dockerOptsParser True <*> nixOptsParser True <*> firstBoolFlags "system-ghc" "using the system installed GHC (on the PATH) if available and a matching version" hide <*> firstBoolFlags "install-ghc" "downloading and installing GHC if necessary (can be done manually with stack setup)" hide <*> optionalFirst (strOption ( long "arch" <> metavar "ARCH" <> help "System architecture, e.g. i386, x86_64" <> hide )) <*> optionalFirst (strOption ( long "os" <> metavar "OS" <> help "Operating system, e.g. linux, windows" <> hide )) <*> optionalFirst (ghcVariantParser (hide0 /= OuterGlobalOpts)) <*> optionalFirst (option auto ( long "jobs" <> short 'j' <> metavar "JOBS" <> help "Number of concurrent jobs to run" <> hide )) <*> fmap Set.fromList (many (textOption ( long "extra-include-dirs" <> metavar "DIR" <> help "Extra directories to check for C header files" <> hide ))) <*> fmap Set.fromList (many (textOption ( long "extra-lib-dirs" <> metavar "DIR" <> help "Extra directories to check for libraries" <> hide ))) <*> firstBoolFlags "skip-ghc-check" "skipping the GHC version and architecture check" hide <*> firstBoolFlags "skip-msys" "skipping the local MSYS installation (Windows only)" hide <*> optionalFirst (strOption ( long "local-bin-path" <> metavar "DIR" <> help "Install binaries to DIR" <> hide )) <*> firstBoolFlags "modify-code-page" "setting the codepage to support UTF-8 (Windows only)" hide <*> firstBoolFlags "allow-different-user" ("permission for users other than the owner of the stack root " ++ "directory to use a stack installation (POSIX only)") hide where hide = hideMods (hide0 /= OuterGlobalOpts) readAbsDir :: ReadM (Path Abs Dir) readAbsDir = do s <- readerAsk case parseAbsDir s of Just p -> return p Nothing -> readerError ("Failed to parse absolute path to directory: '" ++ s ++ "'") buildOptsMonoidParser :: Bool -> Parser BuildOptsMonoid buildOptsMonoidParser hide0 = transform <$> trace <*> profile <*> options where hide = hideMods hide0 transform tracing profiling = enable where enable opts | tracing || profiling = opts { buildMonoidLibProfile = First (Just True) , buildMonoidExeProfile = First (Just True) , buildMonoidBenchmarkOpts = bopts { beoMonoidAdditionalArgs = First (getFirst (beoMonoidAdditionalArgs bopts) <> Just (" " <> unwords additionalArgs)) } , buildMonoidTestOpts = topts { toMonoidAdditionalArgs = (toMonoidAdditionalArgs topts) <> additionalArgs } } | otherwise = opts where bopts = buildMonoidBenchmarkOpts opts topts = buildMonoidTestOpts opts additionalArgs = "+RTS" : catMaybes [trac, prof, Just "-RTS"] trac = if tracing then Just "-xc" else Nothing prof = if profiling then Just "-p" else Nothing profile = flag False True (long "profile" <> help "Enable profiling in libraries, executables, etc. \ \for all expressions and generate a profiling report\ \ in exec or benchmarks" <> hide) trace = flag False True (long "trace" <> help "Enable profiling in libraries, executables, etc. \ \for all expressions and generate a backtrace on \ \exception" <> hide) options = BuildOptsMonoid <$> libProfiling <*> exeProfiling <*> haddock <*> haddockOptsParser hide0 <*> openHaddocks <*> haddockDeps <*> copyBins <*> preFetch <*> keepGoing <*> forceDirty <*> tests <*> testOptsParser hide0 <*> benches <*> benchOptsParser hide0 <*> reconfigure <*> cabalVerbose <*> splitObjs libProfiling = firstBoolFlags "library-profiling" "library profiling for TARGETs and all its dependencies" hide exeProfiling = firstBoolFlags "executable-profiling" "executable profiling for TARGETs and all its dependencies" hide haddock = firstBoolFlags "haddock" "generating Haddocks the package(s) in this directory/configuration" hide openHaddocks = firstBoolFlags "open" "opening the local Haddock documentation in the browser" hide haddockDeps = firstBoolFlags "haddock-deps" "building Haddocks for dependencies" hide copyBins = firstBoolFlags "copy-bins" "copying binaries to the local-bin-path (see 'stack path')" hide keepGoing = firstBoolFlags "keep-going" "continue running after a step fails (default: false for build, true for test/bench)" hide preFetch = firstBoolFlags "prefetch" "Fetch packages necessary for the build immediately, useful with --dry-run" hide forceDirty = firstBoolFlags "force-dirty" "Force treating all local packages as having dirty files (useful for cases where stack can't detect a file change" hide tests = firstBoolFlags "test" "testing the package(s) in this directory/configuration" hide benches = firstBoolFlags "bench" "benchmarking the package(s) in this directory/configuration" hide reconfigure = firstBoolFlags "reconfigure" "Perform the configure step even if unnecessary. Useful in some corner cases with custom Setup.hs files" hide cabalVerbose = firstBoolFlags "cabal-verbose" "Ask Cabal to be verbose in its output" hide splitObjs = firstBoolFlags "split-objs" ("Enable split-objs, to reduce output size (at the cost of build time). " ++ splitObjsWarning) hide nixOptsParser :: Bool -> Parser NixOptsMonoid nixOptsParser hide0 = overrideActivation <$> (NixOptsMonoid <$> pure (Any False) <*> firstBoolFlags nixCmdName "use of a Nix-shell" hide <*> firstBoolFlags "nix-pure" "use of a pure Nix-shell" hide <*> optionalFirst (textArgsOption (long "nix-packages" <> metavar "NAMES" <> help "List of packages that should be available in the nix-shell (space separated)" <> hide)) <*> optionalFirst (option str (long "nix-shell-file" <> metavar "FILEPATH" <> help "Nix file to be used to launch a nix-shell (for regular Nix users)" <> hide)) <*> optionalFirst (textArgsOption (long "nix-shell-options" <> metavar "OPTIONS" <> help "Additional options passed to nix-shell" <> hide)) <*> optionalFirst (textArgsOption (long "nix-path" <> metavar "PATH_OPTIONS" <> help "Additional options to override NIX_PATH parts (notably 'nixpkgs')" <> hide)) ) where hide = hideMods hide0 overrideActivation m = if m /= mempty then m { nixMonoidEnable = (First . Just . fromFirst True) (nixMonoidEnable m) } else m textArgsOption = fmap (map T.pack) . argsOption -- | Options parser configuration for Docker. dockerOptsParser :: Bool -> Parser DockerOptsMonoid dockerOptsParser hide0 = DockerOptsMonoid <$> pure (Any False) <*> firstBoolFlags dockerCmdName "using a Docker container" hide <*> fmap First ((Just . DockerMonoidRepo) <$> option str (long (dockerOptName dockerRepoArgName) <> hide <> metavar "NAME" <> help "Docker repository name") <|> (Just . DockerMonoidImage) <$> option str (long (dockerOptName dockerImageArgName) <> hide <> metavar "IMAGE" <> help "Exact Docker image ID (overrides docker-repo)") <|> pure Nothing) <*> firstBoolFlags (dockerOptName dockerRegistryLoginArgName) "registry requires login" hide <*> firstStrOption (long (dockerOptName dockerRegistryUsernameArgName) <> hide <> metavar "USERNAME" <> help "Docker registry username") <*> firstStrOption (long (dockerOptName dockerRegistryPasswordArgName) <> hide <> metavar "PASSWORD" <> help "Docker registry password") <*> firstBoolFlags (dockerOptName dockerAutoPullArgName) "automatic pulling latest version of image" hide <*> firstBoolFlags (dockerOptName dockerDetachArgName) "running a detached Docker container" hide <*> firstBoolFlags (dockerOptName dockerPersistArgName) "not deleting container after it exits" hide <*> firstStrOption (long (dockerOptName dockerContainerNameArgName) <> hide <> metavar "NAME" <> help "Docker container name") <*> argsOption (long (dockerOptName dockerRunArgsArgName) <> hide <> value [] <> metavar "'ARG1 [ARG2 ...]'" <> help "Additional options to pass to 'docker run'") <*> many (option auto (long (dockerOptName dockerMountArgName) <> hide <> metavar "(PATH | HOST-PATH:CONTAINER-PATH)" <> help ("Mount volumes from host in container " ++ "(may specify multiple times)"))) <*> many (option str (long (dockerOptName dockerEnvArgName) <> hide <> metavar "NAME=VALUE" <> help ("Set environment variable in container " ++ "(may specify multiple times)"))) <*> firstStrOption (long (dockerOptName dockerDatabasePathArgName) <> hide <> metavar "PATH" <> help "Location of image usage tracking database") <*> firstStrOption (long(dockerOptName dockerStackExeArgName) <> hide <> metavar (intercalate "|" [ dockerStackExeDownloadVal , dockerStackExeHostVal , dockerStackExeImageVal , "PATH" ]) <> help (concat [ "Location of " , stackProgName , " executable used in container" ])) <*> firstBoolFlags (dockerOptName dockerSetUserArgName) "setting user in container to match host" hide <*> pure (IntersectingVersionRange anyVersion) where dockerOptName optName = dockerCmdName ++ "-" ++ T.unpack optName firstStrOption = optionalFirst . option str hide = hideMods hide0 -- | Parser for docker cleanup arguments. dockerCleanupOptsParser :: Parser Docker.CleanupOpts dockerCleanupOptsParser = Docker.CleanupOpts <$> (flag' Docker.CleanupInteractive (short 'i' <> long "interactive" <> help "Show cleanup plan in editor and allow changes (default)") <|> flag' Docker.CleanupImmediate (short 'y' <> long "immediate" <> help "Immediately execute cleanup plan") <|> flag' Docker.CleanupDryRun (short 'n' <> long "dry-run" <> help "Display cleanup plan but do not execute") <|> pure Docker.CleanupInteractive) <*> opt (Just 14) "known-images" "LAST-USED" <*> opt Nothing "unknown-images" "CREATED" <*> opt (Just 0) "dangling-images" "CREATED" <*> opt Nothing "stopped-containers" "CREATED" <*> opt Nothing "running-containers" "CREATED" where opt def' name mv = fmap Just (option auto (long name <> metavar (mv ++ "-DAYS-AGO") <> help ("Remove " ++ toDescr name ++ " " ++ map toLower (toDescr mv) ++ " N days ago" ++ case def' of Just n -> " (default " ++ show n ++ ")" Nothing -> ""))) <|> flag' Nothing (long ("no-" ++ name) <> help ("Do not remove " ++ toDescr name ++ case def' of Just _ -> "" Nothing -> " (default)")) <|> pure def' toDescr = map (\c -> if c == '-' then ' ' else c) -- | Parser for arguments to `stack dot` dotOptsParser :: Parser DotOpts dotOptsParser = DotOpts <$> includeExternal <*> includeBase <*> depthLimit <*> fmap (maybe Set.empty Set.fromList . fmap splitNames) prunedPkgs where includeExternal = boolFlags False "external" "inclusion of external dependencies" idm includeBase = boolFlags True "include-base" "inclusion of dependencies on base" idm depthLimit = optional (option auto (long "depth" <> metavar "DEPTH" <> help ("Limit the depth of dependency resolution " <> "(Default: No limit)"))) prunedPkgs = optional (strOption (long "prune" <> metavar "PACKAGES" <> help ("Prune each package name " <> "from the comma separated list " <> "of package names PACKAGES"))) splitNames :: String -> [String] splitNames = map (takeWhile (not . isSpace) . dropWhile isSpace) . splitOn "," ghciOptsParser :: Parser GhciOpts ghciOptsParser = GhciOpts <$> switch (long "no-build" <> help "Don't build before launching GHCi") <*> fmap concat (many (argsOption (long "ghci-options" <> metavar "OPTION" <> help "Additional options passed to GHCi"))) <*> optional (strOption (long "with-ghc" <> metavar "GHC" <> help "Use this GHC to run GHCi")) <*> (not <$> boolFlags True "load" "load modules on start-up" idm) <*> packagesParser <*> optional (textOption (long "main-is" <> metavar "TARGET" <> help "Specify which target should contain the main \ \module to load, such as for an executable for \ \test suite or benchmark.")) <*> switch (long "load-local-deps" <> help "Load all local dependencies of your targets") <*> switch (long "skip-intermediate-deps" <> help "Skip loading intermediate target dependencies") <*> boolFlags True "package-hiding" "package hiding" idm <*> buildOptsParser Build -- | Parser for exec command execOptsParser :: Maybe SpecialExecCmd -> Parser ExecOpts execOptsParser mcmd = ExecOpts <$> maybe eoCmdParser pure mcmd <*> eoArgsParser <*> execOptsExtraParser where eoCmdParser = ExecCmd <$> strArgument (metavar "CMD") eoArgsParser = many (strArgument (metavar "-- ARGS (e.g. stack ghc -- X.hs -o x)")) evalOptsParser :: String -- ^ metavar -> Parser EvalOpts evalOptsParser meta = EvalOpts <$> eoArgsParser <*> execOptsExtraParser where eoArgsParser :: Parser String eoArgsParser = strArgument (metavar meta) -- | Parser for extra options to exec command execOptsExtraParser :: Parser ExecOptsExtra execOptsExtraParser = eoPlainParser <|> ExecOptsEmbellished <$> eoEnvSettingsParser <*> eoPackagesParser where eoEnvSettingsParser :: Parser EnvSettings eoEnvSettingsParser = EnvSettings <$> pure True <*> boolFlags True "ghc-package-path" "setting the GHC_PACKAGE_PATH variable for the subprocess" idm <*> boolFlags True "stack-exe" "setting the STACK_EXE environment variable to the path for the stack executable" idm <*> pure False eoPackagesParser :: Parser [String] eoPackagesParser = many (strOption (long "package" <> help "Additional packages that must be installed")) eoPlainParser :: Parser ExecOptsExtra eoPlainParser = flag' ExecOptsPlain (long "plain" <> help "Use an unmodified environment (only useful with Docker)") -- | Parser for global command-line options. globalOptsParser :: GlobalOptsContext -> Maybe LogLevel -> Parser GlobalOptsMonoid globalOptsParser kind defLogLevel = GlobalOptsMonoid <$> optionalFirst (strOption (long Docker.reExecArgName <> hidden <> internal)) <*> optionalFirst (option auto (long dockerEntrypointArgName <> hidden <> internal)) <*> (First <$> logLevelOptsParser hide0 defLogLevel) <*> configOptsParser kind <*> optionalFirst (abstractResolverOptsParser hide0) <*> optionalFirst (compilerOptsParser hide0) <*> firstBoolFlags "terminal" "overriding terminal detection in the case of running in a false terminal" hide <*> optionalFirst (strOption (long "stack-yaml" <> metavar "STACK-YAML" <> help ("Override project stack.yaml file " <> "(overrides any STACK_YAML environment variable)") <> hide)) where hide = hideMods hide0 hide0 = kind /= OuterGlobalOpts -- | Create GlobalOpts from GlobalOptsMonoid. globalOptsFromMonoid :: Bool -> GlobalOptsMonoid -> GlobalOpts globalOptsFromMonoid defaultTerminal GlobalOptsMonoid{..} = GlobalOpts { globalReExecVersion = getFirst globalMonoidReExecVersion , globalDockerEntrypoint = getFirst globalMonoidDockerEntrypoint , globalLogLevel = fromFirst defaultLogLevel globalMonoidLogLevel , globalConfigMonoid = globalMonoidConfigMonoid , globalResolver = getFirst globalMonoidResolver , globalCompiler = getFirst globalMonoidCompiler , globalTerminal = fromFirst defaultTerminal globalMonoidTerminal , globalStackYaml = getFirst globalMonoidStackYaml } initOptsParser :: Parser InitOpts initOptsParser = InitOpts <$> searchDirs <*> solver <*> omitPackages <*> overwrite <*> fmap not ignoreSubDirs where searchDirs = many (textArgument (metavar "DIRS" <> help "Directories to include, default is current directory.")) ignoreSubDirs = switch (long "ignore-subdirs" <> help "Do not search for .cabal files in sub directories") overwrite = switch (long "force" <> help "Force overwriting an existing stack.yaml") omitPackages = switch (long "omit-packages" <> help "Exclude conflicting or incompatible user packages") solver = switch (long "solver" <> help "Use a dependency solver to determine extra dependencies") -- | Parser for a logging level. logLevelOptsParser :: Bool -> Maybe LogLevel -> Parser (Maybe LogLevel) logLevelOptsParser hide defLogLevel = fmap (Just . parse) (strOption (long "verbosity" <> metavar "VERBOSITY" <> help "Verbosity: silent, error, warn, info, debug" <> hideMods hide)) <|> flag' (Just verboseLevel) (short 'v' <> long "verbose" <> help ("Enable verbose mode: verbosity level \"" <> showLevel verboseLevel <> "\"") <> hideMods hide) <|> flag' (Just silentLevel) (long "silent" <> help ("Enable silent mode: verbosity level \"" <> showLevel silentLevel <> "\"") <> hideMods hide) <|> pure defLogLevel where verboseLevel = LevelDebug silentLevel = LevelOther "silent" showLevel l = case l of LevelDebug -> "debug" LevelInfo -> "info" LevelWarn -> "warn" LevelError -> "error" LevelOther x -> T.unpack x parse s = case s of "debug" -> LevelDebug "info" -> LevelInfo "warn" -> LevelWarn "error" -> LevelError _ -> LevelOther (T.pack s) -- | Parser for the resolver abstractResolverOptsParser :: Bool -> Parser AbstractResolver abstractResolverOptsParser hide = option readAbstractResolver (long "resolver" <> metavar "RESOLVER" <> help "Override resolver in project file" <> hideMods hide) readAbstractResolver :: ReadM AbstractResolver readAbstractResolver = do s <- readerAsk case s of "global" -> return ARGlobal "nightly" -> return ARLatestNightly "lts" -> return ARLatestLTS 'l':'t':'s':'-':x | Right (x', "") <- decimal $ T.pack x -> return $ ARLatestLTSMajor x' _ -> case parseResolverText $ T.pack s of Left e -> readerError $ show e Right x -> return $ ARResolver x compilerOptsParser :: Bool -> Parser CompilerVersion compilerOptsParser hide = option readCompilerVersion (long "compiler" <> metavar "COMPILER" <> help "Use the specified compiler" <> hideMods hide) readCompilerVersion :: ReadM CompilerVersion readCompilerVersion = do s <- readerAsk case parseCompilerVersion (T.pack s) of Nothing -> readerError $ "Failed to parse compiler: " ++ s Just x -> return x -- | GHC variant parser ghcVariantParser :: Bool -> Parser GHCVariant ghcVariantParser hide = option readGHCVariant (long "ghc-variant" <> metavar "VARIANT" <> help "Specialized GHC variant, e.g. integersimple (implies --no-system-ghc)" <> hideMods hide ) where readGHCVariant = do s <- readerAsk case parseGHCVariant s of Left e -> readerError (show e) Right v -> return v -- | Parser for @solverCmd@ solverOptsParser :: Parser Bool solverOptsParser = boolFlags False "update-config" "Automatically update stack.yaml with the solver's recommendations" idm -- | Parser for haddock arguments. haddockOptsParser :: Bool -> Parser HaddockOptsMonoid haddockOptsParser hide0 = HaddockOptsMonoid <$> fmap (fromMaybe []) (optional (argsOption (long "haddock-arguments" <> metavar "HADDOCK_ARGS" <> help "Arguments passed to the haddock program" <> hide))) where hide = hideMods hide0 -- | Parser for test arguments. -- FIXME hide args testOptsParser :: Bool -> Parser TestOptsMonoid testOptsParser hide0 = TestOptsMonoid <$> firstBoolFlags "rerun-tests" "running already successful tests" hide <*> fmap (fromMaybe []) (optional (argsOption (long "test-arguments" <> metavar "TEST_ARGS" <> help "Arguments passed in to the test suite program" <> hide))) <*> optionalFirst (switch (long "coverage" <> help "Generate a code coverage report" <> hide)) <*> optionalFirst (switch (long "no-run-tests" <> help "Disable running of tests. (Tests will still be built.)" <> hide)) where hide = hideMods hide0 -- | Parser for @stack new@. newOptsParser :: Parser (NewOpts,InitOpts) newOptsParser = (,) <$> newOpts <*> initOptsParser where newOpts = NewOpts <$> packageNameArgument (metavar "PACKAGE_NAME" <> help "A valid package name.") <*> switch (long "bare" <> help "Do not create a subdirectory for the project") <*> optional (templateNameArgument (metavar "TEMPLATE_NAME" <> help "Name of a template or a local template in a file or a URL.\ \ For example: foo or foo.hsfiles or ~/foo or\ \ https://example.com/foo.hsfiles")) <*> fmap M.fromList (many (templateParamArgument (short 'p' <> long "param" <> metavar "KEY:VALUE" <> help "Parameter for the template in the format key:value"))) -- | Parser for @stack hpc report@. hpcReportOptsParser :: Parser HpcReportOpts hpcReportOptsParser = HpcReportOpts <$> many (textArgument $ metavar "TARGET_OR_TIX") <*> switch (long "all" <> help "Use results from all packages and components") <*> optional (strOption (long "destdir" <> help "Output directy for HTML report")) pvpBoundsOption :: Parser PvpBounds pvpBoundsOption = option readPvpBounds (long "pvp-bounds" <> metavar "PVP-BOUNDS" <> help "How PVP version bounds should be added to .cabal file: none, lower, upper, both") where readPvpBounds = do s <- readerAsk case parsePvpBounds $ T.pack s of Left e -> readerError e Right v -> return v configCmdSetParser :: Parser ConfigCmdSet configCmdSetParser = fromM (do field <- oneM (strArgument (metavar "FIELD VALUE")) oneM (fieldToValParser field)) where fieldToValParser :: String -> Parser ConfigCmdSet fieldToValParser s = case s of "resolver" -> ConfigCmdSetResolver <$> argument readAbstractResolver idm _ -> error "parse stack config set field: only set resolver is implemented" -- | If argument is True, hides the option from usage and help hideMods :: Bool -> Mod f a hideMods hide = if hide then internal <> hidden else idm stack-1.1.2/src/Stack/Package.hs0000644000000000000000000014232512717707441014552 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE RecordWildCards #-} -- | Dealing with Cabal. module Stack.Package (readPackage ,readPackageBS ,readPackageDescriptionDir ,readPackageUnresolved ,readPackageUnresolvedBS ,resolvePackage ,findOrGenerateCabalFile ,hpack ,Package(..) ,GetPackageFiles(..) ,GetPackageOpts(..) ,PackageConfig(..) ,buildLogPath ,PackageException (..) ,resolvePackageDescription ,packageToolDependencies ,packageDependencies ,autogenDir ,checkCabalFileName ,printCabalFileWarning ,cabalFilePackageId) where import Prelude () import Prelude.Compat import Control.Arrow ((&&&)) import Control.Exception hiding (try,catch) import Control.Monad (liftM, liftM2, (<=<), when, forM, forM_) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (MonadReader,runReaderT,ask,asks) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C8 import Data.List.Compat import Data.List.Extra (nubOrd) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe import Data.Maybe.Extra import Data.Monoid import Data.Set (Set) import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Data.Version (showVersion) import Distribution.Compiler import Distribution.ModuleName (ModuleName) import qualified Distribution.ModuleName as Cabal import qualified Distribution.Package as D import Distribution.Package hiding (Package,PackageName,packageName,packageVersion,PackageIdentifier) import qualified Distribution.PackageDescription as D import Distribution.PackageDescription hiding (FlagName) import Distribution.PackageDescription.Parse import qualified Distribution.PackageDescription.Parse as D import Distribution.ParseUtils import Distribution.Simple.Utils import Distribution.System (OS (..), Arch, Platform (..)) import Distribution.Text (display, simpleParse) import qualified Distribution.Verbosity as D import qualified Hpack import qualified Hpack.Config as Hpack import Path as FL import Path.Extra import Path.Find import Path.IO hiding (findFiles) import Safe (headDef, tailSafe) import Stack.Build.Installed import Stack.Constants import Stack.Types import qualified System.Directory as D import System.FilePath (splitExtensions, replaceExtension) import qualified System.FilePath as FilePath import System.IO.Error -- | Read the raw, unresolved package information. readPackageUnresolved :: (MonadIO m, MonadThrow m) => Path Abs File -> m ([PWarning],GenericPackageDescription) readPackageUnresolved cabalfp = liftIO (BS.readFile (FL.toFilePath cabalfp)) >>= readPackageUnresolvedBS (Just cabalfp) -- | Read the raw, unresolved package information from a ByteString. readPackageUnresolvedBS :: (MonadThrow m) => Maybe (Path Abs File) -> BS.ByteString -> m ([PWarning],GenericPackageDescription) readPackageUnresolvedBS mcabalfp bs = case parsePackageDescription chars of ParseFailed per -> throwM (PackageInvalidCabalFile mcabalfp per) ParseOk warnings gpkg -> return (warnings,gpkg) where chars = T.unpack (dropBOM (decodeUtf8With lenientDecode bs)) -- https://github.com/haskell/hackage-server/issues/351 dropBOM t = fromMaybe t $ T.stripPrefix "\xFEFF" t -- | Reads and exposes the package information readPackage :: (MonadLogger m, MonadIO m, MonadCatch m) => PackageConfig -> Path Abs File -> m ([PWarning],Package) readPackage packageConfig cabalfp = do (warnings,gpkg) <- readPackageUnresolved cabalfp return (warnings,resolvePackage packageConfig gpkg) -- | Reads and exposes the package information, from a ByteString readPackageBS :: (MonadThrow m) => PackageConfig -> BS.ByteString -> m ([PWarning],Package) readPackageBS packageConfig bs = do (warnings,gpkg) <- readPackageUnresolvedBS Nothing bs return (warnings,resolvePackage packageConfig gpkg) -- | Get 'GenericPackageDescription' and 'PackageDescription' reading info -- from given directory. readPackageDescriptionDir :: (MonadLogger m, MonadIO m, MonadCatch m) => PackageConfig -> Path Abs Dir -> m (GenericPackageDescription, PackageDescription) readPackageDescriptionDir config pkgDir = do cabalfp <- findOrGenerateCabalFile pkgDir gdesc <- liftM snd (readPackageUnresolved cabalfp) return (gdesc, resolvePackageDescription config gdesc) -- | Print cabal file warnings. printCabalFileWarning :: (MonadLogger m) => Path Abs File -> PWarning -> m () printCabalFileWarning cabalfp = \case (PWarning x) -> $logWarn ("Cabal file warning in " <> T.pack (toFilePath cabalfp) <> ": " <> T.pack x) (UTFWarning line msg) -> $logWarn ("Cabal file warning in " <> T.pack (toFilePath cabalfp) <> ":" <> T.pack (show line) <> ": " <> T.pack msg) -- | Check if the given name in the @Package@ matches the name of the .cabal file checkCabalFileName :: MonadThrow m => PackageName -> Path Abs File -> m () checkCabalFileName name cabalfp = do -- Previously, we just use parsePackageNameFromFilePath. However, that can -- lead to confusing error messages. See: -- https://github.com/commercialhaskell/stack/issues/895 let expected = packageNameString name ++ ".cabal" when (expected /= toFilePath (filename cabalfp)) $ throwM $ MismatchedCabalName cabalfp name -- | Resolve a parsed cabal file into a 'Package'. resolvePackage :: PackageConfig -> GenericPackageDescription -> Package resolvePackage packageConfig gpkg = Package { packageName = name , packageVersion = fromCabalVersion (pkgVersion pkgId) , packageDeps = deps , packageFiles = pkgFiles , packageTools = packageDescTools pkg , packageGhcOptions = packageConfigGhcOptions packageConfig , packageFlags = packageConfigFlags packageConfig , packageDefaultFlags = M.fromList [(fromCabalFlagName (flagName flag), flagDefault flag) | flag <- genPackageFlags gpkg] , packageAllDeps = S.fromList (M.keys deps) , packageHasLibrary = maybe False (buildable . libBuildInfo) (library pkg) , packageTests = M.fromList [(T.pack (testName t), testInterface t) | t <- testSuites pkg , buildable (testBuildInfo t)] , packageBenchmarks = S.fromList [T.pack (benchmarkName biBuildInfo) | biBuildInfo <- benchmarks pkg , buildable (benchmarkBuildInfo biBuildInfo)] , packageExes = S.fromList [T.pack (exeName biBuildInfo) | biBuildInfo <- executables pkg , buildable (buildInfo biBuildInfo)] , packageOpts = GetPackageOpts $ \sourceMap installedMap omitPkgs addPkgs cabalfp -> do (componentsModules,componentFiles,_,_) <- getPackageFiles pkgFiles cabalfp componentsOpts <- generatePkgDescOpts sourceMap installedMap omitPkgs addPkgs cabalfp pkg componentFiles return (componentsModules,componentFiles,componentsOpts) , packageHasExposedModules = maybe False (not . null . exposedModules) (library pkg) , packageSimpleType = buildType (packageDescription gpkg) == Just Simple } where pkgFiles = GetPackageFiles $ \cabalfp -> do let pkgDir = parent cabalfp distDir <- distDirFromDir pkgDir (componentModules,componentFiles,dataFiles',warnings) <- runReaderT (packageDescModulesAndFiles pkg) (cabalfp, buildDir distDir) setupFiles <- if buildType pkg `elem` [Nothing, Just Custom] then do let setupHsPath = pkgDir $(mkRelFile "Setup.hs") setupLhsPath = pkgDir $(mkRelFile "Setup.lhs") setupHsExists <- doesFileExist setupHsPath if setupHsExists then return (S.singleton setupHsPath) else do setupLhsExists <- doesFileExist setupLhsPath if setupLhsExists then return (S.singleton setupLhsPath) else return S.empty else return S.empty buildFiles <- liftM (S.insert cabalfp . S.union setupFiles) $ do let hpackPath = pkgDir $(mkRelFile Hpack.packageConfig) hpackExists <- doesFileExist hpackPath return $ if hpackExists then S.singleton hpackPath else S.empty return (componentModules, componentFiles, buildFiles <> dataFiles', warnings) pkgId = package (packageDescription gpkg) name = fromCabalPackageName (pkgName pkgId) pkg = resolvePackageDescription packageConfig gpkg deps = M.filterWithKey (const . (/= name)) (packageDependencies pkg) -- | Generate GHC options for the package's components, and a list of -- options which apply generally to the package, not one specific -- component. generatePkgDescOpts :: (HasEnvConfig env, MonadThrow m, MonadReader env m, MonadIO m) => SourceMap -> InstalledMap -> [PackageName] -- ^ Packages to omit from the "-package" / "-package-id" flags -> [PackageName] -- ^ Packages to add to the "-package" flags -> Path Abs File -> PackageDescription -> Map NamedComponent (Set DotCabalPath) -> m (Map NamedComponent BuildInfoOpts) generatePkgDescOpts sourceMap installedMap omitPkgs addPkgs cabalfp pkg componentPaths = do config <- asks getConfig distDir <- distDirFromDir cabalDir let cabalMacros = autogenDir distDir $(mkRelFile "cabal_macros.h") exists <- doesFileExist cabalMacros let mcabalMacros = if exists then Just cabalMacros else Nothing let generate namedComponent binfo = ( namedComponent , generateBuildInfoOpts BioInput { biSourceMap = sourceMap , biInstalledMap = installedMap , biCabalMacros = mcabalMacros , biCabalDir = cabalDir , biDistDir = distDir , biOmitPackages = omitPkgs , biAddPackages = addPkgs , biBuildInfo = binfo , biDotCabalPaths = fromMaybe mempty (M.lookup namedComponent componentPaths) , biConfigLibDirs = configExtraLibDirs config , biConfigIncludeDirs = configExtraIncludeDirs config , biComponentName = namedComponent } ) return ( M.fromList (concat [ maybe [] (return . generate CLib . libBuildInfo) (library pkg) , fmap (\exe -> generate (CExe (T.pack (exeName exe))) (buildInfo exe)) (executables pkg) , fmap (\bench -> generate (CBench (T.pack (benchmarkName bench))) (benchmarkBuildInfo bench)) (benchmarks pkg) , fmap (\test -> generate (CTest (T.pack (testName test))) (testBuildInfo test)) (testSuites pkg)])) where cabalDir = parent cabalfp data BioInput = BioInput { biSourceMap :: !SourceMap , biInstalledMap :: !InstalledMap , biCabalMacros :: !(Maybe (Path Abs File)) , biCabalDir :: !(Path Abs Dir) , biDistDir :: !(Path Abs Dir) , biOmitPackages :: ![PackageName] , biAddPackages :: ![PackageName] , biBuildInfo :: !BuildInfo , biDotCabalPaths :: !(Set DotCabalPath) , biConfigLibDirs :: !(Set Text) , biConfigIncludeDirs :: !(Set Text) , biComponentName :: !NamedComponent } -- | Generate GHC options for the target. generateBuildInfoOpts :: BioInput -> BuildInfoOpts generateBuildInfoOpts BioInput {..} = BuildInfoOpts { bioOpts = ghcOpts ++ cppOptions biBuildInfo -- NOTE for future changes: Due to this use of nubOrd (and other uses -- downstream), these generated options must not rely on multiple -- argument sequences. For example, ["--main-is", "Foo.hs", "--main- -- is", "Bar.hs"] would potentially break due to the duplicate -- "--main-is" being removed. -- -- See https://github.com/commercialhaskell/stack/issues/1255 , bioOneWordOpts = nubOrd $ concat [extOpts, srcOpts, includeOpts, libOpts, fworks, cObjectFiles] , bioPackageFlags = deps , bioCabalMacros = biCabalMacros } where cObjectFiles = mapMaybe (fmap toFilePath . makeObjectFilePathFromC biCabalDir biComponentName biDistDir) cfiles cfiles = mapMaybe dotCabalCFilePath (S.toList biDotCabalPaths) -- Generates: -package=base -package=base16-bytestring-0.1.1.6 ... deps = concat [ case M.lookup name biInstalledMap of Just (_, Stack.Types.Library _ident ipid) -> ["-package-id=" <> ghcPkgIdString ipid] _ -> ["-package=" <> packageNameString name <> maybe "" -- This empty case applies to e.g. base. ((("-" <>) . versionString) . piiVersion) (M.lookup name biSourceMap)] | name <- pkgs] pkgs = biAddPackages ++ [ name | Dependency cname _ <- targetBuildDepends biBuildInfo , let name = fromCabalPackageName cname , name `notElem` biOmitPackages] ghcOpts = concatMap snd . filter (isGhc . fst) $ options biBuildInfo where isGhc GHC = True isGhc _ = False extOpts = map (("-X" ++) . display) (usedExtensions biBuildInfo) srcOpts = map (("-i" <>) . toFilePathNoTrailingSep) ([biCabalDir | null (hsSourceDirs biBuildInfo)] <> mapMaybe toIncludeDir (hsSourceDirs biBuildInfo) <> [autogenDir biDistDir,buildDir biDistDir] <> [makeGenDir (buildDir biDistDir) | Just makeGenDir <- [fileGenDirFromComponentName biComponentName]]) ++ ["-stubdir=" ++ toFilePathNoTrailingSep (buildDir biDistDir)] toIncludeDir "." = Just biCabalDir toIncludeDir x = fmap (biCabalDir ) (parseRelDir x) includeOpts = map ("-I" <>) (configExtraIncludeDirs <> pkgIncludeOpts) configExtraIncludeDirs = map T.unpack (S.toList biConfigIncludeDirs) pkgIncludeOpts = [ toFilePathNoTrailingSep absDir | dir <- includeDirs biBuildInfo , absDir <- handleDir dir ] libOpts = map ("-l" <>) (extraLibs biBuildInfo) <> map ("-L" <>) (configExtraLibDirs <> pkgLibDirs) configExtraLibDirs = map T.unpack (S.toList biConfigLibDirs) pkgLibDirs = [ toFilePathNoTrailingSep absDir | dir <- extraLibDirs biBuildInfo , absDir <- handleDir dir ] handleDir dir = case (parseAbsDir dir, parseRelDir dir) of (Just ab, _ ) -> [ab] (_ , Just rel) -> [biCabalDir rel] (Nothing, Nothing ) -> [] fworks = map (\fwk -> "-framework=" <> fwk) (frameworks biBuildInfo) -- | Make the .o path from the .c file path for a component. Example: -- -- @ -- executable FOO -- c-sources: cbits/text_search.c -- @ -- -- Produces -- -- /build/FOO/FOO-tmp/cbits/text_search.o -- -- Example: -- -- λ> makeObjectFilePathFromC -- $(mkAbsDir "/Users/chris/Repos/hoogle") -- CLib -- $(mkAbsDir "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist") -- $(mkAbsFile "/Users/chris/Repos/hoogle/cbits/text_search.c") -- Just "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist/build/cbits/text_search.o" -- λ> makeObjectFilePathFromC -- $(mkAbsDir "/Users/chris/Repos/hoogle") -- (CExe "hoogle") -- $(mkAbsDir "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist") -- $(mkAbsFile "/Users/chris/Repos/hoogle/cbits/text_search.c") -- Just "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist/build/hoogle/hoogle-tmp/cbits/text_search.o" -- λ> makeObjectFilePathFromC :: MonadThrow m => Path Abs Dir -- ^ The cabal directory. -> NamedComponent -- ^ The name of the component. -> Path Abs Dir -- ^ Dist directory. -> Path Abs File -- ^ The path to the .c file. -> m (Path Abs File) -- ^ The path to the .o file for the component. makeObjectFilePathFromC cabalDir namedComponent distDir cFilePath = do relCFilePath <- stripDir cabalDir cFilePath relOFilePath <- parseRelFile (replaceExtension (toFilePath relCFilePath) "o") addComponentPrefix <- fileGenDirFromComponentName namedComponent return (addComponentPrefix (buildDir distDir) relOFilePath) -- | The directory where generated files are put like .o or .hs (from .x files). fileGenDirFromComponentName :: MonadThrow m => NamedComponent -> m (Path b Dir -> Path b Dir) fileGenDirFromComponentName namedComponent = case namedComponent of CLib -> return id CExe name -> makeTmp name CTest name -> makeTmp name CBench name -> makeTmp name where makeTmp name = do prefix <- parseRelDir (T.unpack name <> "/" <> T.unpack name <> "-tmp") return ( prefix) -- | Make the autogen dir. autogenDir :: Path Abs Dir -> Path Abs Dir autogenDir distDir = buildDir distDir $(mkRelDir "autogen") -- | Make the build dir. buildDir :: Path Abs Dir -> Path Abs Dir buildDir distDir = distDir $(mkRelDir "build") -- | Make the component-specific subdirectory of the build directory. getBuildComponentDir :: Maybe String -> Maybe (Path Rel Dir) getBuildComponentDir Nothing = Nothing getBuildComponentDir (Just name) = parseRelDir (name FilePath. (name ++ "-tmp")) -- | Get all dependencies of the package (buildable targets only). packageDependencies :: PackageDescription -> Map PackageName VersionRange packageDependencies = M.fromListWith intersectVersionRanges . concatMap (fmap (depName &&& depRange) . targetBuildDepends) . allBuildInfo' -- | Get all build tool dependencies of the package (buildable targets only). packageToolDependencies :: PackageDescription -> Map Text VersionRange packageToolDependencies = M.fromList . concatMap (fmap (packageNameText . depName &&& depRange) . buildTools) . allBuildInfo' -- | Get all dependencies of the package (buildable targets only). packageDescTools :: PackageDescription -> [Dependency] packageDescTools = concatMap buildTools . allBuildInfo' -- | This is a copy-paste from Cabal's @allBuildInfo@ function, but with the -- @buildable@ test removed. The reason is that (surprise) Cabal is broken, -- see: https://github.com/haskell/cabal/issues/1725 allBuildInfo' :: PackageDescription -> [BuildInfo] allBuildInfo' pkg_descr = [ bi | Just lib <- [library pkg_descr] , let bi = libBuildInfo lib , True || buildable bi ] ++ [ bi | exe <- executables pkg_descr , let bi = buildInfo exe , True || buildable bi ] ++ [ bi | tst <- testSuites pkg_descr , let bi = testBuildInfo tst , True || buildable bi , testEnabled tst ] ++ [ bi | tst <- benchmarks pkg_descr , let bi = benchmarkBuildInfo tst , True || buildable bi , benchmarkEnabled tst ] -- | Get all files referenced by the package. packageDescModulesAndFiles :: (MonadLogger m, MonadIO m, MonadReader (Path Abs File, Path Abs Dir) m, MonadCatch m) => PackageDescription -> m (Map NamedComponent (Set ModuleName), Map NamedComponent (Set DotCabalPath), Set (Path Abs File), [PackageWarning]) packageDescModulesAndFiles pkg = do (libraryMods,libDotCabalFiles,libWarnings) <- maybe (return (M.empty, M.empty, [])) (asModuleAndFileMap libComponent libraryFiles) (library pkg) (executableMods,exeDotCabalFiles,exeWarnings) <- liftM foldTuples (mapM (asModuleAndFileMap exeComponent executableFiles) (executables pkg)) (testMods,testDotCabalFiles,testWarnings) <- liftM foldTuples (mapM (asModuleAndFileMap testComponent testFiles) (testSuites pkg)) (benchModules,benchDotCabalPaths,benchWarnings) <- liftM foldTuples (mapM (asModuleAndFileMap benchComponent benchmarkFiles) (benchmarks pkg)) (dfiles) <- resolveGlobFiles (map (dataDir pkg FilePath.) (dataFiles pkg)) let modules = libraryMods <> executableMods <> testMods <> benchModules files = libDotCabalFiles <> exeDotCabalFiles <> testDotCabalFiles <> benchDotCabalPaths warnings = libWarnings <> exeWarnings <> testWarnings <> benchWarnings return (modules, files, dfiles, warnings) where libComponent = const CLib exeComponent = CExe . T.pack . exeName testComponent = CTest . T.pack . testName benchComponent = CBench . T.pack . benchmarkName asModuleAndFileMap label f lib = do (a,b,c) <- f lib return (M.singleton (label lib) a, M.singleton (label lib) b, c) foldTuples = foldl' (<>) (M.empty, M.empty, []) -- | Resolve globbing of files (e.g. data files) to absolute paths. resolveGlobFiles :: (MonadLogger m,MonadIO m,MonadReader (Path Abs File, Path Abs Dir) m,MonadCatch m) => [String] -> m (Set (Path Abs File)) resolveGlobFiles = liftM (S.fromList . catMaybes . concat) . mapM resolve where resolve name = if '*' `elem` name then explode name else liftM return (resolveFileOrWarn name) explode name = do dir <- asks (parent . fst) names <- matchDirFileGlob' (FL.toFilePath dir) name mapM resolveFileOrWarn names matchDirFileGlob' dir glob = catch (matchDirFileGlob_ dir glob) (\(e :: IOException) -> if isUserError e then do $logWarn ("Wildcard does not match any files: " <> T.pack glob <> "\n" <> "in directory: " <> T.pack dir) return [] else throwM e) -- | This is a copy/paste of the Cabal library function, but with -- -- @ext == ext'@ -- -- Changed to -- -- @isSuffixOf ext ext'@ -- -- So that this will work: -- -- @ -- λ> matchDirFileGlob_ "." "test/package-dump/*.txt" -- ["test/package-dump/ghc-7.8.txt","test/package-dump/ghc-7.10.txt"] -- @ -- matchDirFileGlob_ :: (MonadLogger m, MonadIO m) => String -> String -> m [String] matchDirFileGlob_ dir filepath = case parseFileGlob filepath of Nothing -> liftIO $ die $ "invalid file glob '" ++ filepath ++ "'. Wildcards '*' are only allowed in place of the file" ++ " name, not in the directory name or file extension." ++ " If a wildcard is used it must be with an file extension." Just (NoGlob filepath') -> return [filepath'] Just (FileGlob dir' ext) -> do efiles <- liftIO $ try $ D.getDirectoryContents (dir FilePath. dir') let matches = case efiles of Left (_ :: IOException) -> [] Right files -> [ dir' FilePath. file | file <- files , let (name, ext') = splitExtensions file , not (null name) && isSuffixOf ext ext' ] when (null matches) $ $logWarn $ "WARNING: filepath wildcard '" <> T.pack filepath <> "' does not match any files." return matches -- | Get all files referenced by the benchmark. benchmarkFiles :: (MonadLogger m, MonadIO m, MonadCatch m, MonadReader (Path Abs File, Path Abs Dir) m) => Benchmark -> m (Set ModuleName, Set DotCabalPath, [PackageWarning]) benchmarkFiles bench = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . fst) (modules,files,warnings) <- resolveFilesAndDeps (Just $ benchmarkName bench) (dirs ++ [dir]) (bnames <> exposed) haskellModuleExts cfiles <- buildOtherSources build return (modules, files <> cfiles, warnings) where exposed = case benchmarkInterface bench of BenchmarkExeV10 _ fp -> [DotCabalMain fp] BenchmarkUnsupported _ -> [] bnames = map DotCabalModule (otherModules build) build = benchmarkBuildInfo bench -- | Get all files referenced by the test. testFiles :: (MonadLogger m, MonadIO m, MonadCatch m, MonadReader (Path Abs File, Path Abs Dir) m) => TestSuite -> m (Set ModuleName, Set DotCabalPath, [PackageWarning]) testFiles test = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . fst) (modules,files,warnings) <- resolveFilesAndDeps (Just $ testName test) (dirs ++ [dir]) (bnames <> exposed) haskellModuleExts cfiles <- buildOtherSources build return (modules, files <> cfiles, warnings) where exposed = case testInterface test of TestSuiteExeV10 _ fp -> [DotCabalMain fp] TestSuiteLibV09 _ mn -> [DotCabalModule mn] TestSuiteUnsupported _ -> [] bnames = map DotCabalModule (otherModules build) build = testBuildInfo test -- | Get all files referenced by the executable. executableFiles :: (MonadLogger m, MonadIO m, MonadCatch m, MonadReader (Path Abs File, Path Abs Dir) m) => Executable -> m (Set ModuleName, Set DotCabalPath, [PackageWarning]) executableFiles exe = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . fst) (modules,files,warnings) <- resolveFilesAndDeps (Just $ exeName exe) (dirs ++ [dir]) (map DotCabalModule (otherModules build) ++ [DotCabalMain (modulePath exe)]) haskellModuleExts cfiles <- buildOtherSources build return (modules, files <> cfiles, warnings) where build = buildInfo exe -- | Get all files referenced by the library. libraryFiles :: (MonadLogger m, MonadIO m, MonadCatch m, MonadReader (Path Abs File, Path Abs Dir) m) => Library -> m (Set ModuleName, Set DotCabalPath, [PackageWarning]) libraryFiles lib = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . fst) (modules,files,warnings) <- resolveFilesAndDeps Nothing (dirs ++ [dir]) (names <> exposed) haskellModuleExts cfiles <- buildOtherSources build return (modules, files <> cfiles, warnings) where names = bnames ++ exposed exposed = map DotCabalModule (exposedModules lib) bnames = map DotCabalModule (otherModules build) build = libBuildInfo lib -- | Get all C sources and extra source files in a build. buildOtherSources :: (MonadLogger m,MonadIO m,MonadCatch m,MonadReader (Path Abs File, Path Abs Dir) m) => BuildInfo -> m (Set DotCabalPath) buildOtherSources build = do csources <- liftM (S.map DotCabalCFilePath . S.fromList) (mapMaybeM resolveFileOrWarn (cSources build)) jsources <- liftM (S.map DotCabalFilePath . S.fromList) (mapMaybeM resolveFileOrWarn (targetJsSources build)) return (csources <> jsources) -- | Get the target's JS sources. targetJsSources :: BuildInfo -> [FilePath] #if MIN_VERSION_Cabal(1, 22, 0) targetJsSources = jsSources #else targetJsSources = const [] #endif -- | Get all dependencies of a package, including library, -- executables, tests, benchmarks. resolvePackageDescription :: PackageConfig -> GenericPackageDescription -> PackageDescription resolvePackageDescription packageConfig (GenericPackageDescription desc defaultFlags mlib exes tests benches) = desc {library = fmap (resolveConditions rc updateLibDeps) mlib ,executables = map (\(n, v) -> (resolveConditions rc updateExeDeps v){exeName=n}) exes ,testSuites = map (\(n,v) -> (resolveConditions rc updateTestDeps v){testName=n}) tests ,benchmarks = map (\(n,v) -> (resolveConditions rc updateBenchmarkDeps v){benchmarkName=n}) benches} where flags = M.union (packageConfigFlags packageConfig) (flagMap defaultFlags) rc = mkResolveConditions (packageConfigCompilerVersion packageConfig) (packageConfigPlatform packageConfig) flags updateLibDeps lib deps = lib {libBuildInfo = (libBuildInfo lib) {targetBuildDepends = deps}} updateExeDeps exe deps = exe {buildInfo = (buildInfo exe) {targetBuildDepends = deps}} updateTestDeps test deps = test {testBuildInfo = (testBuildInfo test) {targetBuildDepends = deps} ,testEnabled = packageConfigEnableTests packageConfig} updateBenchmarkDeps benchmark deps = benchmark {benchmarkBuildInfo = (benchmarkBuildInfo benchmark) {targetBuildDepends = deps} ,benchmarkEnabled = packageConfigEnableBenchmarks packageConfig} -- | Make a map from a list of flag specifications. -- -- What is @flagManual@ for? flagMap :: [Flag] -> Map FlagName Bool flagMap = M.fromList . map pair where pair :: Flag -> (FlagName, Bool) pair (MkFlag (fromCabalFlagName -> name) _desc def _manual) = (name,def) data ResolveConditions = ResolveConditions { rcFlags :: Map FlagName Bool , rcCompilerVersion :: CompilerVersion , rcOS :: OS , rcArch :: Arch } -- | Generic a @ResolveConditions@ using sensible defaults. mkResolveConditions :: CompilerVersion -- ^ Compiler version -> Platform -- ^ installation target platform -> Map FlagName Bool -- ^ enabled flags -> ResolveConditions mkResolveConditions compilerVersion (Platform arch os) flags = ResolveConditions { rcFlags = flags , rcCompilerVersion = compilerVersion , rcOS = os , rcArch = arch } -- | Resolve the condition tree for the library. resolveConditions :: (Monoid target,Show target) => ResolveConditions -> (target -> cs -> target) -> CondTree ConfVar cs target -> target resolveConditions rc addDeps (CondNode lib deps cs) = basic <> children where basic = addDeps lib deps children = mconcat (map apply cs) where apply (cond,node,mcs) = if condSatisfied cond then resolveConditions rc addDeps node else maybe mempty (resolveConditions rc addDeps) mcs condSatisfied c = case c of Var v -> varSatisifed v Lit b -> b CNot c' -> not (condSatisfied c') COr cx cy -> condSatisfied cx || condSatisfied cy CAnd cx cy -> condSatisfied cx && condSatisfied cy varSatisifed v = case v of OS os -> os == rcOS rc Arch arch -> arch == rcArch rc Flag flag -> fromMaybe False $ M.lookup (fromCabalFlagName flag) (rcFlags rc) -- NOTE: ^^^^^ This should never happen, as all flags -- which are used must be declared. Defaulting to -- False. Impl flavor range -> case (flavor, rcCompilerVersion rc) of (GHC, GhcVersion vghc) -> vghc `withinRange` range (GHC, GhcjsVersion _ vghc) -> vghc `withinRange` range #if MIN_VERSION_Cabal(1, 22, 0) (GHCJS, GhcjsVersion vghcjs _) -> #else (OtherCompiler "ghcjs", GhcjsVersion vghcjs _) -> #endif vghcjs `withinRange` range _ -> False -- | Get the name of a dependency. depName :: Dependency -> PackageName depName (Dependency n _) = fromCabalPackageName n -- | Get the version range of a dependency. depRange :: Dependency -> VersionRange depRange (Dependency _ r) = r -- | Try to resolve the list of base names in the given directory by -- looking for unique instances of base names applied with the given -- extensions, plus find any of their module and TemplateHaskell -- dependencies. resolveFilesAndDeps :: (MonadIO m, MonadLogger m, MonadCatch m, MonadReader (Path Abs File, Path Abs Dir) m) => Maybe String -- ^ Package component name -> [Path Abs Dir] -- ^ Directories to look in. -> [DotCabalDescriptor] -- ^ Base names. -> [Text] -- ^ Extensions. -> m (Set ModuleName,Set DotCabalPath,[PackageWarning]) resolveFilesAndDeps component dirs names0 exts = do (dotCabalPaths, foundModules, missingModules) <- loop names0 S.empty warnings <- liftM2 (++) (warnUnlisted foundModules) (warnMissing missingModules) return (foundModules, dotCabalPaths, warnings) where loop [] _ = return (S.empty, S.empty, []) loop names doneModules0 = do resolved <- resolveFiles dirs names exts let foundFiles = mapMaybe snd resolved (foundModules', missingModules') = partition (isJust . snd) resolved foundModules = mapMaybe (dotCabalModule . fst) foundModules' missingModules = mapMaybe (dotCabalModule . fst) missingModules' pairs <- mapM (getDependencies component) foundFiles let doneModules = S.union doneModules0 (S.fromList (mapMaybe dotCabalModule names)) moduleDeps = S.unions (map fst pairs) thDepFiles = concatMap snd pairs modulesRemaining = S.difference moduleDeps doneModules -- Ignore missing modules discovered as dependencies - they may -- have been deleted. (resolvedFiles, resolvedModules, _) <- loop (map DotCabalModule (S.toList modulesRemaining)) doneModules return ( S.union (S.fromList (foundFiles <> map DotCabalFilePath thDepFiles)) resolvedFiles , S.union (S.fromList foundModules) resolvedModules , missingModules) warnUnlisted foundModules = do let unlistedModules = foundModules `S.difference` S.fromList (mapMaybe dotCabalModule names0) cabalfp <- asks fst return $ if S.null unlistedModules then [] else [ UnlistedModulesWarning cabalfp component (S.toList unlistedModules)] warnMissing _missingModules = do return [] {- FIXME: the issue with this is it's noisy for modules like Paths_* cabalfp <- asks fst return $ if null missingModules then [] else [ MissingModulesWarning cabalfp component missingModules] -} -- | Get the dependencies of a Haskell module file. getDependencies :: (MonadReader (Path Abs File, Path Abs Dir) m, MonadIO m, MonadCatch m, MonadLogger m) => Maybe String -> DotCabalPath -> m (Set ModuleName, [Path Abs File]) getDependencies component dotCabalPath = case dotCabalPath of DotCabalModulePath resolvedFile -> readResolvedHi resolvedFile DotCabalMainPath resolvedFile -> readResolvedHi resolvedFile DotCabalFilePath{} -> return (S.empty, []) DotCabalCFilePath{} -> return (S.empty, []) where readResolvedHi resolvedFile = do dumpHIDir <- getDumpHIDir dir <- asks (parent . fst) case stripDir dir resolvedFile of Nothing -> return (S.empty, []) Just fileRel -> do let dumpHIPath = FilePath.replaceExtension (toFilePath (dumpHIDir fileRel)) ".dump-hi" dumpHIExists <- liftIO $ D.doesFileExist dumpHIPath if dumpHIExists then parseDumpHI dumpHIPath else return (S.empty, []) getDumpHIDir = do bld <- asks snd return $ maybe bld (bld ) (getBuildComponentDir component) -- | Parse a .dump-hi file into a set of modules and files. parseDumpHI :: (MonadReader (Path Abs File, void) m, MonadIO m, MonadCatch m, MonadLogger m) => FilePath -> m (Set ModuleName, [Path Abs File]) parseDumpHI dumpHIPath = do dir <- asks (parent . fst) dumpHI <- liftIO $ fmap C8.lines (C8.readFile dumpHIPath) let startModuleDeps = dropWhile (not . ("module dependencies:" `C8.isPrefixOf`)) dumpHI moduleDeps = S.fromList $ mapMaybe (simpleParse . T.unpack . decodeUtf8) $ C8.words $ C8.concat $ C8.dropWhile (/= ' ') (headDef "" startModuleDeps) : takeWhile (" " `C8.isPrefixOf`) (tailSafe startModuleDeps) thDeps = -- The dependent file path is surrounded by quotes but is not escaped. -- It can be an absolute or relative path. mapMaybe ((fmap T.unpack . (T.stripSuffix "\"" <=< T.stripPrefix "\"") . T.dropWhileEnd (== '\r') . decodeUtf8 . C8.dropWhile (/= '"'))) $ filter ("addDependentFile \"" `C8.isPrefixOf`) dumpHI thDepsResolved <- liftM catMaybes $ forM thDeps $ \x -> do mresolved <- forgivingAbsence (resolveFile dir x) >>= rejectMissingFile when (isNothing mresolved) $ $logWarn $ "Warning: qAddDepedency path listed in " <> T.pack dumpHIPath <> " does not exist: " <> T.pack x return mresolved return (moduleDeps, thDepsResolved) -- | Try to resolve the list of base names in the given directory by -- looking for unique instances of base names applied with the given -- extensions. resolveFiles :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m) => [Path Abs Dir] -- ^ Directories to look in. -> [DotCabalDescriptor] -- ^ Base names. -> [Text] -- ^ Extensions. -> m [(DotCabalDescriptor, Maybe DotCabalPath)] resolveFiles dirs names exts = forM names (\name -> liftM (name, ) (findCandidate dirs exts name)) -- | Find a candidate for the given module-or-filename from the list -- of directories and given extensions. findCandidate :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m) => [Path Abs Dir] -> [Text] -> DotCabalDescriptor -> m (Maybe DotCabalPath) findCandidate dirs exts name = do pkg <- asks fst >>= parsePackageNameFromFilePath candidates <- liftIO makeNameCandidates case candidates of [candidate] -> return (Just (cons candidate)) [] -> do case name of DotCabalModule mn | display mn /= paths_pkg pkg -> logPossibilities dirs mn _ -> return () return Nothing (candidate:rest) -> do warnMultiple name candidate rest return (Just (cons candidate)) where cons = case name of DotCabalModule{} -> DotCabalModulePath DotCabalMain{} -> DotCabalMainPath DotCabalFile{} -> DotCabalFilePath DotCabalCFile{} -> DotCabalCFilePath paths_pkg pkg = "Paths_" ++ packageNameString pkg makeNameCandidates = liftM (nubOrd . concat) (mapM makeDirCandidates dirs) makeDirCandidates :: Path Abs Dir -> IO [Path Abs File] makeDirCandidates dir = case name of DotCabalMain fp -> resolveCandidate dir fp DotCabalFile fp -> resolveCandidate dir fp DotCabalCFile fp -> resolveCandidate dir fp DotCabalModule mn -> liftM concat $ mapM ((\ ext -> resolveCandidate dir (Cabal.toFilePath mn ++ "." ++ ext)) . T.unpack) exts resolveCandidate :: (MonadIO m, MonadThrow m) => Path Abs Dir -> FilePath.FilePath -> m [Path Abs File] resolveCandidate x y = do -- The standard canonicalizePath does not work for this case p <- parseCollapsedAbsFile (toFilePath x FilePath. y) exists <- doesFileExist p return $ if exists then [p] else [] -- | Warn the user that multiple candidates are available for an -- entry, but that we picked one anyway and continued. warnMultiple :: MonadLogger m => DotCabalDescriptor -> Path b t -> [Path b t] -> m () warnMultiple name candidate rest = $logWarn ("There were multiple candidates for the Cabal entry \"" <> showName name <> "\" (" <> T.intercalate "," (map (T.pack . toFilePath) rest) <> "), picking " <> T.pack (toFilePath candidate)) where showName (DotCabalModule name') = T.pack (display name') showName (DotCabalMain fp) = T.pack fp showName (DotCabalFile fp) = T.pack fp showName (DotCabalCFile fp) = T.pack fp -- | Log that we couldn't find a candidate, but there are -- possibilities for custom preprocessor extensions. -- -- For example: .erb for a Ruby file might exist in one of the -- directories. logPossibilities :: (MonadIO m, MonadThrow m, MonadLogger m) => [Path Abs Dir] -> ModuleName -> m () logPossibilities dirs mn = do possibilities <- liftM concat (makePossibilities mn) case possibilities of [] -> return () _ -> $logWarn ("Unable to find a known candidate for the Cabal entry \"" <> T.pack (display mn) <> "\", but did find: " <> T.intercalate ", " (map (T.pack . toFilePath) possibilities) <> ". If you are using a custom preprocessor for this module " <> "with its own file extension, consider adding the file(s) " <> "to your .cabal under extra-source-files.") where makePossibilities name = mapM (\dir -> do (_,files) <- listDir dir return (map filename (filter (isPrefixOf (display name) . toFilePath . filename) files))) dirs -- | Get the filename for the cabal file in the given directory. -- -- If no .cabal file is present, or more than one is present, an exception is -- thrown via 'throwM'. -- -- If the directory contains a file named package.yaml, hpack is used to -- generate a .cabal file from it. findOrGenerateCabalFile :: forall m. (MonadThrow m, MonadIO m, MonadLogger m) => Path Abs Dir -- ^ package directory -> m (Path Abs File) findOrGenerateCabalFile pkgDir = do hpack pkgDir findCabalFile where findCabalFile :: m (Path Abs File) findCabalFile = findCabalFile' >>= either throwM return findCabalFile' :: m (Either PackageException (Path Abs File)) findCabalFile' = do files <- liftIO $ findFiles pkgDir (flip hasExtension "cabal" . FL.toFilePath) (const False) return $ case files of [] -> Left $ PackageNoCabalFileFound pkgDir [x] -> Right x -- If there are multiple files, ignore files that start with -- ".". On unixlike environments these are hidden, and this -- character is not valid in package names. The main goal is -- to ignore emacs lock files - see -- https://github.com/commercialhaskell/stack/issues/1897. (filter (not . ("." `isPrefixOf`) . toFilePath . filename) -> [x]) -> Right x _:_ -> Left $ PackageMultipleCabalFilesFound pkgDir files where hasExtension fp x = FilePath.takeExtension fp == "." ++ x -- | Generate .cabal file from package.yaml, if necessary. hpack :: (MonadIO m, MonadLogger m) => Path Abs Dir -> m () hpack pkgDir = do let hpackFile = pkgDir $(mkRelFile Hpack.packageConfig) exists <- liftIO $ doesFileExist hpackFile when exists $ do let fpt = T.pack (toFilePath hpackFile) $logDebug $ "Running hpack on " <> fpt r <- liftIO $ Hpack.hpackResult (toFilePath pkgDir) forM_ (Hpack.resultWarnings r) $ \w -> $logWarn ("WARNING: " <> T.pack w) let cabalFile = T.pack (Hpack.resultCabalFile r) case Hpack.resultStatus r of Hpack.Generated -> $logDebug $ "hpack generated a modified version of " <> cabalFile Hpack.OutputUnchanged -> $logDebug $ "hpack output unchanged in " <> cabalFile -- NOTE: this is 'logInfo' so it will be outputted to the -- user by default. Hpack.AlreadyGeneratedByNewerHpack -> $logWarn $ "WARNING: " <> cabalFile <> " was generated with a newer version of hpack, please upgrade and try again." -- | Path for the package's build log. buildLogPath :: (MonadReader env m, HasBuildConfig env, MonadThrow m) => Package -> Maybe String -> m (Path Abs File) buildLogPath package' msuffix = do env <- ask let stack = getProjectWorkDir env fp <- parseRelFile $ concat $ packageIdentifierString (packageIdentifier package') : maybe id (\suffix -> ("-" :) . (suffix :)) msuffix [".log"] return $ stack $(mkRelDir "logs") fp -- Internal helper to define resolveFileOrWarn and resolveDirOrWarn resolveOrWarn :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m) => Text -> (Path Abs Dir -> String -> m (Maybe a)) -> FilePath.FilePath -> m (Maybe a) resolveOrWarn subject resolver path = do cwd <- getCurrentDir file <- asks fst dir <- asks (parent . fst) result <- resolver dir path when (isNothing result) $ $logWarn ("Warning: " <> subject <> " listed in " <> T.pack (maybe (FL.toFilePath file) FL.toFilePath (stripDir cwd file)) <> " file does not exist: " <> T.pack path) return result -- | Resolve the file, if it can't be resolved, warn for the user -- (purely to be helpful). resolveFileOrWarn :: (MonadCatch m,MonadIO m,MonadLogger m,MonadReader (Path Abs File, Path Abs Dir) m) => FilePath.FilePath -> m (Maybe (Path Abs File)) resolveFileOrWarn = resolveOrWarn "File" f where f p x = forgivingAbsence (resolveFile p x) >>= rejectMissingFile -- | Resolve the directory, if it can't be resolved, warn for the user -- (purely to be helpful). resolveDirOrWarn :: (MonadCatch m,MonadIO m,MonadLogger m,MonadReader (Path Abs File, Path Abs Dir) m) => FilePath.FilePath -> m (Maybe (Path Abs Dir)) resolveDirOrWarn = resolveOrWarn "Directory" f where f p x = forgivingAbsence (resolveDir p x) >>= rejectMissingDir -- | Extract the @PackageIdentifier@ given an exploded haskell package -- path. cabalFilePackageId :: (MonadIO m, MonadThrow m) => Path Abs File -> m PackageIdentifier cabalFilePackageId fp = do pkgDescr <- liftIO (D.readPackageDescription D.silent $ toFilePath fp) (toStackPI . D.package . D.packageDescription) pkgDescr where toStackPI (D.PackageIdentifier (D.PackageName name) ver) = do name' <- parsePackageNameFromString name ver' <- parseVersionFromString (showVersion ver) return (PackageIdentifier name' ver') stack-1.1.2/src/Stack/PackageDump.hs0000644000000000000000000004014312717707441015373 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} module Stack.PackageDump ( Line , eachSection , eachPair , DumpPackage (..) , conduitDumpPackage , ghcPkgDump , ghcPkgDescribe , InstalledCache , InstalledCacheEntry (..) , newInstalledCache , loadInstalledCache , saveInstalledCache , addProfiling , addHaddock , sinkMatching , pruneDeps ) where import Control.Applicative import Control.Arrow ((&&&)) import Control.Exception.Enclosed (tryIO) import Control.Monad (liftM) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger (MonadLogger) import Control.Monad.Trans.Control import Data.Attoparsec.Args import Data.Attoparsec.Text as P import Data.Binary.VersionTagged import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Conduit.Text as CT import Data.Either (partitionEithers) import Data.IORef import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (catMaybes, listToMaybe) import Data.Maybe.Extra (mapMaybeM) import qualified Data.Set as Set import qualified Data.Text as T import Data.Text (Text) import Data.Typeable (Typeable) import GHC.Generics (Generic) import Path import Path.IO (ensureDir) import Path.Extra (toFilePathNoTrailingSep) import Prelude -- Fix AMP warning import Stack.GhcPkg import Stack.Types import System.Directory (getDirectoryContents, doesFileExist) import System.Process.Read -- | Cached information on whether package have profiling libraries and haddocks. newtype InstalledCache = InstalledCache (IORef InstalledCacheInner) newtype InstalledCacheInner = InstalledCacheInner (Map GhcPkgId InstalledCacheEntry) deriving (Binary, NFData, Generic) instance HasStructuralInfo InstalledCacheInner instance HasSemanticVersion InstalledCacheInner -- | Cached information on whether a package has profiling libraries and haddocks. data InstalledCacheEntry = InstalledCacheEntry { installedCacheProfiling :: !Bool , installedCacheHaddock :: !Bool , installedCacheIdent :: !PackageIdentifier } deriving (Eq, Generic) instance Binary InstalledCacheEntry instance HasStructuralInfo InstalledCacheEntry instance NFData InstalledCacheEntry -- | Call ghc-pkg dump with appropriate flags and stream to the given @Sink@, for a single database ghcPkgDump :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> WhichCompiler -> [Path Abs Dir] -- ^ if empty, use global -> Sink Text IO a -> m a ghcPkgDump = ghcPkgCmdArgs ["dump"] -- | Call ghc-pkg describe with appropriate flags and stream to the given @Sink@, for a single database ghcPkgDescribe :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => PackageName -> EnvOverride -> WhichCompiler -> [Path Abs Dir] -- ^ if empty, use global -> Sink Text IO a -> m a ghcPkgDescribe pkgName = ghcPkgCmdArgs ["describe", "--simple-output", packageNameString pkgName] -- | Call ghc-pkg and stream to the given @Sink@, for a single database ghcPkgCmdArgs :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => [String] -> EnvOverride -> WhichCompiler -> [Path Abs Dir] -- ^ if empty, use global -> Sink Text IO a -> m a ghcPkgCmdArgs cmd menv wc mpkgDbs sink = do case reverse mpkgDbs of (pkgDb:_) -> createDatabase menv wc pkgDb -- TODO maybe use some retry logic instead? _ -> return () sinkProcessStdout Nothing menv (ghcPkgExeName wc) args sink' where args = concat [ case mpkgDbs of [] -> ["--global", "--no-user-package-db"] _ -> ["--user", "--no-user-package-db"] ++ concatMap (\pkgDb -> ["--package-db", toFilePathNoTrailingSep pkgDb]) mpkgDbs , cmd , ["--expand-pkgroot"] ] sink' = CT.decodeUtf8 =$= sink -- | Create a new, empty @InstalledCache@ newInstalledCache :: MonadIO m => m InstalledCache newInstalledCache = liftIO $ InstalledCache <$> newIORef (InstalledCacheInner Map.empty) -- | Load a @InstalledCache@ from disk, swallowing any errors and returning an -- empty cache. loadInstalledCache :: (MonadLogger m, MonadIO m) => Path Abs File -> m InstalledCache loadInstalledCache path = do m <- taggedDecodeOrLoad path (return $ InstalledCacheInner Map.empty) liftIO $ InstalledCache <$> newIORef m -- | Save a @InstalledCache@ to disk saveInstalledCache :: MonadIO m => Path Abs File -> InstalledCache -> m () saveInstalledCache path (InstalledCache ref) = liftIO $ do ensureDir (parent path) readIORef ref >>= taggedEncodeFile path -- | Prune a list of possible packages down to those whose dependencies are met. -- -- * id uniquely identifies an item -- -- * There can be multiple items per name pruneDeps :: (Ord name, Ord id) => (id -> name) -- ^ extract the name from an id -> (item -> id) -- ^ the id of an item -> (item -> [id]) -- ^ get the dependencies of an item -> (item -> item -> item) -- ^ choose the desired of two possible items -> [item] -- ^ input items -> Map name item pruneDeps getName getId getDepends chooseBest = Map.fromList . fmap (getName . getId &&& id) . loop Set.empty Set.empty [] where loop foundIds usedNames foundItems dps = case partitionEithers $ map depsMet dps of ([], _) -> foundItems (s', dps') -> let foundIds' = Map.fromListWith chooseBest s' foundIds'' = Set.fromList $ map getId $ Map.elems foundIds' usedNames' = Map.keysSet foundIds' foundItems' = Map.elems foundIds' in loop (Set.union foundIds foundIds'') (Set.union usedNames usedNames') (foundItems ++ foundItems') (catMaybes dps') where depsMet dp | name `Set.member` usedNames = Right Nothing | all (`Set.member` foundIds) (getDepends dp) = Left (name, dp) | otherwise = Right $ Just dp where id' = getId dp name = getName id' -- | Find the package IDs matching the given constraints with all dependencies installed. -- Packages not mentioned in the provided @Map@ are allowed to be present too. sinkMatching :: Monad m => Bool -- ^ require profiling? -> Bool -- ^ require haddock? -> Map PackageName Version -- ^ allowed versions -> Consumer (DumpPackage Bool Bool) m (Map PackageName (DumpPackage Bool Bool)) sinkMatching reqProfiling reqHaddock allowed = do dps <- CL.filter (\dp -> isAllowed (dpPackageIdent dp) && (not reqProfiling || dpProfiling dp) && (not reqHaddock || dpHaddock dp)) =$= CL.consume return $ Map.fromList $ map (packageIdentifierName . dpPackageIdent &&& id) $ Map.elems $ pruneDeps id dpGhcPkgId dpDepends const -- Could consider a better comparison in the future dps where isAllowed (PackageIdentifier name version) = case Map.lookup name allowed of Just version' | version /= version' -> False _ -> True -- | Add profiling information to the stream of @DumpPackage@s addProfiling :: MonadIO m => InstalledCache -> Conduit (DumpPackage a b) m (DumpPackage Bool b) addProfiling (InstalledCache ref) = CL.mapM go where go dp = liftIO $ do InstalledCacheInner m <- readIORef ref let gid = dpGhcPkgId dp p <- case Map.lookup gid m of Just installed -> return (installedCacheProfiling installed) Nothing | null (dpLibraries dp) -> return True Nothing -> do let loop [] = return False loop (dir:dirs) = do econtents <- tryIO $ getDirectoryContents dir let contents = either (const []) id econtents if or [isProfiling content lib | content <- contents , lib <- dpLibraries dp ] && not (null contents) then return True else loop dirs loop $ dpLibDirs dp return dp { dpProfiling = p } isProfiling :: FilePath -- ^ entry in directory -> Text -- ^ name of library -> Bool isProfiling content lib = prefix `T.isPrefixOf` T.pack content where prefix = T.concat ["lib", lib, "_p"] -- | Add haddock information to the stream of @DumpPackage@s addHaddock :: MonadIO m => InstalledCache -> Conduit (DumpPackage a b) m (DumpPackage a Bool) addHaddock (InstalledCache ref) = CL.mapM go where go dp = liftIO $ do InstalledCacheInner m <- readIORef ref let gid = dpGhcPkgId dp h <- case Map.lookup gid m of Just installed -> return (installedCacheHaddock installed) Nothing | not (dpHasExposedModules dp) -> return True Nothing -> do let loop [] = return False loop (ifc:ifcs) = do exists <- doesFileExist ifc if exists then return True else loop ifcs loop $ dpHaddockInterfaces dp return dp { dpHaddock = h } -- | Dump information for a single package data DumpPackage profiling haddock = DumpPackage { dpGhcPkgId :: !GhcPkgId , dpPackageIdent :: !PackageIdentifier , dpLibDirs :: ![FilePath] , dpLibraries :: ![Text] , dpHasExposedModules :: !Bool , dpDepends :: ![GhcPkgId] , dpHaddockInterfaces :: ![FilePath] , dpHaddockHtml :: !(Maybe FilePath) , dpProfiling :: !profiling , dpHaddock :: !haddock , dpIsExposed :: !Bool } deriving (Show, Eq, Ord) data PackageDumpException = MissingSingleField Text (Map Text [Line]) | Couldn'tParseField Text [Line] deriving Typeable instance Exception PackageDumpException instance Show PackageDumpException where show (MissingSingleField name values) = unlines $ concat [ return $ concat [ "Expected single value for field name " , show name , " when parsing ghc-pkg dump output:" ] , map (\(k, v) -> " " ++ show (k, v)) (Map.toList values) ] show (Couldn'tParseField name ls) = "Couldn't parse the field " ++ show name ++ " from lines: " ++ show ls -- | Convert a stream of bytes into a stream of @DumpPackage@s conduitDumpPackage :: MonadThrow m => Conduit Text m (DumpPackage () ()) conduitDumpPackage = (=$= CL.catMaybes) $ eachSection $ do pairs <- eachPair (\k -> (k, ) <$> CL.consume) =$= CL.consume let m = Map.fromList pairs let parseS k = case Map.lookup k m of Just [v] -> return v _ -> throwM $ MissingSingleField k m -- Can't fail: if not found, same as an empty list. See: -- https://github.com/fpco/stack/issues/182 parseM k = Map.findWithDefault [] k m parseDepend :: MonadThrow m => Text -> m (Maybe GhcPkgId) parseDepend "builtin_rts" = return Nothing parseDepend bs = liftM Just $ parseGhcPkgId bs' where (bs', _builtinRts) = case stripSuffixText " builtin_rts" bs of Nothing -> case stripPrefixText "builtin_rts " bs of Nothing -> (bs, False) Just x -> (x, True) Just x -> (x, True) case Map.lookup "id" m of Just ["builtin_rts"] -> return Nothing _ -> do name <- parseS "name" >>= parsePackageName version <- parseS "version" >>= parseVersion ghcPkgId <- parseS "id" >>= parseGhcPkgId -- if a package has no modules, these won't exist let libDirKey = "library-dirs" libraries = parseM "hs-libraries" exposedModules = parseM "exposed-modules" exposed = parseM "exposed" depends <- mapMaybeM parseDepend $ concatMap T.words $ parseM "depends" let parseQuoted key = case mapM (P.parseOnly (argsParser NoEscaping)) val of Left{} -> throwM (Couldn'tParseField key val) Right dirs -> return (concat dirs) where val = parseM key libDirPaths <- parseQuoted libDirKey haddockInterfaces <- parseQuoted "haddock-interfaces" haddockHtml <- parseQuoted "haddock-html" return $ Just DumpPackage { dpGhcPkgId = ghcPkgId , dpPackageIdent = PackageIdentifier name version , dpLibDirs = libDirPaths , dpLibraries = T.words $ T.unwords libraries , dpHasExposedModules = not (null libraries || null exposedModules) , dpDepends = depends , dpHaddockInterfaces = haddockInterfaces , dpHaddockHtml = listToMaybe haddockHtml , dpProfiling = () , dpHaddock = () , dpIsExposed = exposed == ["True"] } stripPrefixText :: Text -> Text -> Maybe Text stripPrefixText x y | x `T.isPrefixOf` y = Just $ T.drop (T.length x) y | otherwise = Nothing stripSuffixText :: Text -> Text -> Maybe Text stripSuffixText x y | x `T.isSuffixOf` y = Just $ T.take (T.length y - T.length x) y | otherwise = Nothing -- | A single line of input, not including line endings type Line = Text -- | Apply the given Sink to each section of output, broken by a single line containing --- eachSection :: Monad m => Sink Line m a -> Conduit Text m a eachSection inner = CL.map (T.filter (/= '\r')) =$= CT.lines =$= start where peekText = await >>= maybe (return Nothing) (\bs -> if T.null bs then peekText else leftover bs >> return (Just bs)) start = peekText >>= maybe (return ()) (const go) go = do x <- toConsumer $ takeWhileC (/= "---") =$= inner yield x CL.drop 1 start -- | Grab each key/value pair eachPair :: Monad m => (Text -> Sink Line m a) -> Conduit Line m a eachPair inner = start where start = await >>= maybe (return ()) start' start' bs1 = toConsumer (valSrc =$= inner key) >>= yield >> start where (key, bs2) = T.break (== ':') bs1 (spaces, bs3) = T.span (== ' ') $ T.drop 1 bs2 indent = T.length key + 1 + T.length spaces valSrc | T.null bs3 = noIndent | otherwise = yield bs3 >> loopIndent indent noIndent = do mx <- await case mx of Nothing -> return () Just bs -> do let (spaces, val) = T.span (== ' ') bs if T.length spaces == 0 then leftover val else do yield val loopIndent (T.length spaces) loopIndent i = loop where loop = await >>= maybe (return ()) go go bs | T.length spaces == i && T.all (== ' ') spaces = yield val >> loop | otherwise = leftover bs where (spaces, val) = T.splitAt i bs -- | General purpose utility takeWhileC :: Monad m => (a -> Bool) -> Conduit a m a takeWhileC f = loop where loop = await >>= maybe (return ()) go go x | f x = yield x >> loop | otherwise = leftover x stack-1.1.2/src/Stack/PackageIndex.hs0000644000000000000000000004243412717707441015542 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Dealing with the 00-index file and all its cabal files. module Stack.PackageIndex ( updateAllIndices , getPackageCaches , getPackageCachesIO , getPackageVersions , getPackageVersionsIO , lookupPackageVersions ) where import qualified Codec.Archive.Tar as Tar import Control.Exception (Exception) import Control.Exception.Enclosed (tryIO) import Control.Monad (unless, when, liftM, void) import Control.Monad.Catch (MonadThrow, throwM, MonadCatch) import qualified Control.Monad.Catch as C import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Logger (MonadLogger, logDebug, logInfo, logWarn) import Control.Monad.Reader (asks) import Control.Monad.Trans.Control import Data.Aeson.Extended import Data.Binary.VersionTagged import qualified Data.ByteString.Lazy as L import Data.Conduit (($$), (=$)) import Data.Conduit.Binary (sinkHandle, sourceHandle) import Data.Conduit.Zlib (ungzip) import Data.Foldable (forM_) import Data.IORef import Data.Int (Int64) import Data.Map (Map) import qualified Data.Map.Strict as Map import Data.Set (Set) import qualified Data.Set as Set import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import Data.Text.Unsafe (unsafeTail) import Data.Traversable (forM) import Data.Typeable (Typeable) import Network.HTTP.Download import Path (mkRelDir, parent, parseRelDir, toFilePath, parseAbsFile, ()) import Path.IO import Prelude -- Fix AMP warning import Stack.Types import Stack.Types.StackT import System.FilePath (takeBaseName, (<.>)) import System.IO (IOMode (ReadMode, WriteMode), withBinaryFile) import System.Process.Read (EnvOverride, doesExecutableExist, readInNull, tryProcessStdout) import System.Process.Run (Cmd(..), callProcessInheritStderrStdout) import Data.Streaming.Process (ProcessExitedUnsuccessfully(..)) -- | Populate the package index caches and return them. populateCache :: (MonadIO m, MonadReader env m, HasConfig env, HasHttpManager env, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> PackageIndex -> m (Map PackageIdentifier PackageCache) populateCache menv index = do requireIndex menv index -- This uses full on lazy I/O instead of ResourceT to provide some -- protections. Caveat emptor path <- configPackageIndex (indexName index) let loadPIS = do $logSticky "Populating index cache ..." lbs <- liftIO $ L.readFile $ Path.toFilePath path loop 0 Map.empty (Tar.read lbs) pis <- loadPIS `C.catch` \e -> do $logWarn $ "Exception encountered when parsing index tarball: " <> T.pack (show (e :: Tar.FormatError)) $logWarn "Automatically updating index and trying again" updateIndex menv index loadPIS when (indexRequireHashes index) $ forM_ (Map.toList pis) $ \(ident, pc) -> case pcDownload pc of Just _ -> return () Nothing -> throwM $ MissingRequiredHashes (indexName index) ident $logStickyDone "Populated index cache." return pis where loop !blockNo !m (Tar.Next e es) = loop (blockNo + entrySizeInBlocks e) (goE blockNo m e) es loop _ m Tar.Done = return m loop _ _ (Tar.Fail e) = throwM e goE blockNo m e = case Tar.entryContent e of Tar.NormalFile lbs size -> case parseNameVersion $ Tar.entryPath e of Just (ident, ".cabal") -> addCabal ident size Just (ident, ".json") -> addJSON ident lbs _ -> m _ -> m where addCabal ident size = Map.insertWith (\_ pcOld -> pcNew { pcDownload = pcDownload pcOld }) ident pcNew m where pcNew = PackageCache { pcOffset = (blockNo + 1) * 512 , pcSize = size , pcDownload = Nothing } addJSON ident lbs = case decode lbs of Nothing -> m Just !pd -> Map.insertWith (\_ pc -> pc { pcDownload = Just pd }) ident PackageCache { pcOffset = 0 , pcSize = 0 , pcDownload = Just pd } m breakSlash x | T.null z = Nothing | otherwise = Just (y, unsafeTail z) where (y, z) = T.break (== '/') x parseNameVersion t1 = do (p', t3) <- breakSlash $ T.map (\c -> if c == '\\' then '/' else c) $ T.pack t1 p <- parsePackageName p' (v', t5) <- breakSlash t3 v <- parseVersion v' let (t6, suffix) = T.break (== '.') t5 if t6 == p' then return (PackageIdentifier p v, suffix) else Nothing data PackageIndexException = GitNotAvailable IndexName | MissingRequiredHashes IndexName PackageIdentifier deriving Typeable instance Exception PackageIndexException instance Show PackageIndexException where show (GitNotAvailable name) = concat [ "Package index " , T.unpack $ indexNameText name , " only provides Git access, and you do not have" , " the git executable on your PATH" ] show (MissingRequiredHashes name ident) = concat [ "Package index " , T.unpack $ indexNameText name , " is configured to require package hashes, but no" , " hash is available for " , packageIdentifierString ident ] -- | Require that an index be present, updating if it isn't. requireIndex :: (MonadIO m,MonadLogger m ,MonadReader env m,HasHttpManager env ,HasConfig env,MonadBaseControl IO m,MonadCatch m) => EnvOverride -> PackageIndex -> m () requireIndex menv index = do tarFile <- configPackageIndex $ indexName index exists <- doesFileExist tarFile unless exists $ updateIndex menv index -- | Update all of the package indices updateAllIndices :: (MonadIO m,MonadLogger m ,MonadReader env m,HasHttpManager env ,HasConfig env,MonadBaseControl IO m, MonadCatch m) => EnvOverride -> m () updateAllIndices menv = do clearPackageCaches asks (configPackageIndices . getConfig) >>= mapM_ (updateIndex menv) -- | Update the index tarball updateIndex :: (MonadIO m,MonadLogger m ,MonadReader env m,HasHttpManager env ,HasConfig env,MonadBaseControl IO m, MonadCatch m) => EnvOverride -> PackageIndex -> m () updateIndex menv index = do let name = indexName index logUpdate mirror = $logSticky $ "Updating package index " <> indexNameText (indexName index) <> " (mirrored at " <> mirror <> ") ..." git <- isGitInstalled menv case (git, indexLocation index) of (True, ILGit url) -> logUpdate url >> updateIndexGit menv name index url (True, ILGitHttp url _) -> logUpdate url >> updateIndexGit menv name index url (_, ILHttp url) -> logUpdate url >> updateIndexHTTP name index url (False, ILGitHttp _ url) -> logUpdate url >> updateIndexHTTP name index url (False, ILGit url) -> logUpdate url >> throwM (GitNotAvailable name) -- | Update the index Git repo and the index tarball updateIndexGit :: (MonadIO m,MonadLogger m,MonadReader env m,HasConfig env,MonadBaseControl IO m, MonadCatch m) => EnvOverride -> IndexName -> PackageIndex -> Text -- ^ Git URL -> m () updateIndexGit menv indexName' index gitUrl = do tarFile <- configPackageIndex indexName' let idxPath = parent tarFile ensureDir idxPath do repoName <- parseRelDir $ takeBaseName $ T.unpack gitUrl let cloneArgs = ["clone" ,T.unpack gitUrl ,toFilePath repoName ,"--depth" ,"1" ,"-b" -- ,"display"] sDir <- configPackageIndexRoot indexName' let suDir = sDir $(mkRelDir "git-update") acfDir = suDir repoName repoExists <- doesDirExist acfDir unless repoExists (readInNull suDir "git" menv cloneArgs Nothing) $logSticky "Fetching package index ..." let runFetch = callProcessInheritStderrStdout (Cmd (Just acfDir) "git" menv ["fetch","--tags","--depth=1"]) runFetch `C.catch` \(ex :: ProcessExitedUnsuccessfully) -> do -- we failed, so wipe the directory and try again, see #1418 $logWarn (T.pack (show ex)) $logStickyDone "Failed to fetch package index, retrying." removeDirRecur acfDir readInNull suDir "git" menv cloneArgs Nothing $logSticky "Fetching package index ..." runFetch $logStickyDone "Fetched package index." when (indexGpgVerify index) (readInNull acfDir "git" menv ["tag","-v","current-hackage"] (Just (T.unlines ["Signature verification failed. " ,"Please ensure you've set up your" ,"GPG keychain to accept the D6CF60FD signing key." ,"For more information, see:" ,"https://github.com/fpco/stackage-update#readme"]))) -- generate index archive when commit id differs from cloned repo tarId <- getTarCommitId (toFilePath tarFile) cloneId <- getCloneCommitId acfDir unless (tarId `equals` cloneId) (generateArchive acfDir tarFile) where getTarCommitId fp = tryProcessStdout Nothing menv "sh" ["-c","git get-tar-commit-id < "++fp] getCloneCommitId dir = tryProcessStdout (Just dir) menv "git" ["rev-parse","current-hackage^{}"] equals (Right cid1) (Right cid2) = cid1 == cid2 equals _ _ = False generateArchive acfDir tarFile = do ignoringAbsence (removeFile tarFile) deleteCache indexName' $logDebug ("Exporting a tarball to " <> (T.pack . toFilePath) tarFile) let tarFileTmp = toFilePath tarFile ++ ".tmp" readInNull acfDir "git" menv ["archive","--format=tar","-o",tarFileTmp,"current-hackage"] Nothing tarFileTmpPath <- parseAbsFile tarFileTmp renameFile tarFileTmpPath tarFile -- | Update the index tarball via HTTP updateIndexHTTP :: (MonadIO m,MonadLogger m ,MonadThrow m,MonadReader env m,HasHttpManager env,HasConfig env) => IndexName -> PackageIndex -> Text -- ^ url -> m () updateIndexHTTP indexName' index url = do req <- parseUrl $ T.unpack url $logInfo ("Downloading package index from " <> url) gz <- configPackageIndexGz indexName' tar <- configPackageIndex indexName' wasDownloaded <- redownload req gz toUnpack <- if wasDownloaded then return True else not `liftM` doesFileExist tar when toUnpack $ do let tmp = toFilePath tar <.> "tmp" tmpPath <- parseAbsFile tmp deleteCache indexName' liftIO $ do withBinaryFile (toFilePath gz) ReadMode $ \input -> withBinaryFile tmp WriteMode $ \output -> sourceHandle input $$ ungzip =$ sinkHandle output renameFile tmpPath tar when (indexGpgVerify index) $ $logWarn $ "You have enabled GPG verification of the package index, " <> "but GPG verification only works with Git downloading" -- | Is the git executable installed? isGitInstalled :: MonadIO m => EnvOverride -> m Bool isGitInstalled = flip doesExecutableExist "git" -- | Delete the package index cache deleteCache :: (MonadIO m, MonadReader env m, HasConfig env, MonadLogger m, MonadThrow m) => IndexName -> m () deleteCache indexName' = do fp <- configPackageIndexCache indexName' eres <- liftIO $ tryIO $ removeFile fp case eres of Left e -> $logDebug $ "Could not delete cache: " <> T.pack (show e) Right () -> $logDebug $ "Deleted index cache at " <> T.pack (toFilePath fp) -- | Lookup a package's versions from 'IO'. getPackageVersionsIO :: (MonadIO m, MonadReader env m, HasConfig env, MonadLogger m, HasHttpManager env, MonadBaseControl IO m, MonadCatch m) => m (PackageName -> IO (Set Version)) getPackageVersionsIO = do getCaches <- getPackageCachesIO return $ \name -> fmap (lookupPackageVersions name) getCaches -- | Get the known versions for a given package from the package caches. -- -- See 'getPackageCaches' for performance notes. getPackageVersions :: (MonadIO m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, MonadBaseControl IO m, MonadCatch m) => PackageName -> m (Set Version) getPackageVersions pkgName = fmap (lookupPackageVersions pkgName) getPackageCaches lookupPackageVersions :: PackageName -> Map PackageIdentifier a -> Set Version lookupPackageVersions pkgName pkgCaches = Set.fromList [v | PackageIdentifier n v <- Map.keys pkgCaches, n == pkgName] -- | Access the package caches from 'IO'. -- -- FIXME: This is a temporary solution until a better solution -- to access the package caches from Stack.Build.ConstructPlan -- has been found. getPackageCachesIO :: (MonadIO m, MonadReader env m, HasConfig env, MonadLogger m, HasHttpManager env, MonadBaseControl IO m, MonadCatch m) => m (IO (Map PackageIdentifier (PackageIndex, PackageCache))) getPackageCachesIO = toIO getPackageCaches where toIO :: (MonadIO m, MonadBaseControl IO m) => m a -> m (IO a) toIO m = do runInBase <- liftBaseWith $ \run -> return (void . run) return $ do i <- newIORef (error "Impossible evaluation in toIO") runInBase $ do x <- m liftIO $ writeIORef i x readIORef i -- | Load the package caches, or create the caches if necessary. -- -- This has two levels of caching: in memory, and the on-disk cache. So, -- feel free to call this function multiple times. getPackageCaches :: (MonadIO m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, MonadBaseControl IO m, MonadCatch m) => m (Map PackageIdentifier (PackageIndex, PackageCache)) getPackageCaches = do menv <- getMinimalEnvOverride config <- askConfig mcached <- liftIO $ readIORef (configPackageCaches config) case mcached of Just cached -> return cached Nothing -> do result <- liftM mconcat $ forM (configPackageIndices config) $ \index -> do fp <- configPackageIndexCache (indexName index) PackageCacheMap pis' <- taggedDecodeOrLoad fp $ liftM PackageCacheMap $ populateCache menv index return (fmap (index,) pis') liftIO $ writeIORef (configPackageCaches config) (Just result) return result -- | Clear the in-memory hackage index cache. This is needed when the -- hackage index is updated. clearPackageCaches :: (MonadIO m, MonadReader env m, HasConfig env) => m () clearPackageCaches = do cacheRef <- asks (configPackageCaches . getConfig) liftIO $ writeIORef cacheRef Nothing --------------- Lifted from cabal-install, Distribution.Client.Tar: -- | Return the number of blocks in an entry. entrySizeInBlocks :: Tar.Entry -> Int64 entrySizeInBlocks entry = 1 + case Tar.entryContent entry of Tar.NormalFile _ size -> bytesToBlocks size Tar.OtherEntryType _ _ size -> bytesToBlocks size _ -> 0 where bytesToBlocks s = 1 + ((fromIntegral s - 1) `div` 512) stack-1.1.2/src/Stack/SDist.hs0000644000000000000000000003500612717707441014242 0ustar0000000000000000{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} -- Create a source distribution tarball module Stack.SDist ( getSDistTarball , checkSDistTarball , checkSDistTarball' ) where import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Entry as Tar import qualified Codec.Compression.GZip as GZip import Control.Applicative import Control.Concurrent.Execute (ActionContext(..)) import Control.Monad (unless, void, liftM) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Trans.Control (liftBaseWith) import Control.Monad.Trans.Resource import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.Data (Data, Typeable, cast, gmapT) import Data.Either (partitionEithers) import Data.List import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE import Data.Time.Clock.POSIX import Distribution.Package (Dependency (..)) import qualified Distribution.PackageDescription.Check as Check import Distribution.PackageDescription.PrettyPrint (showGenericPackageDescription) import Distribution.Version (simplifyVersionRange, orLaterVersion, earlierVersion) import Distribution.Version.Extra import Network.HTTP.Client.Conduit (HasHttpManager) import Path import Path.IO hiding (getModificationTime, getPermissions) import Prelude -- Fix redundant import warnings import Stack.Build (mkBaseConfigOpts) import Stack.Build.Execute import Stack.Build.Installed import Stack.Build.Source (loadSourceMap, getDefaultPackageConfig) import Stack.Build.Target import Stack.Constants import Stack.Package import Stack.Types import Stack.Types.Internal import System.Directory (getModificationTime, getPermissions) import qualified System.FilePath as FP -- | Special exception to throw when you want to fail because of bad results -- of package check. data CheckException = CheckException (NonEmpty Check.PackageCheck) deriving (Typeable) instance Exception CheckException instance Show CheckException where show (CheckException xs) = "Package check reported the following errors:\n" ++ (intercalate "\n" . fmap show . NE.toList $ xs) type M env m = (MonadIO m,MonadReader env m,HasHttpManager env,MonadLogger m,MonadBaseControl IO m,MonadMask m,HasLogLevel env,HasEnvConfig env,HasTerminal env) -- | Given the path to a local package, creates its source -- distribution tarball. -- -- While this yields a 'FilePath', the name of the tarball, this -- tarball is not written to the disk and instead yielded as a lazy -- bytestring. getSDistTarball :: M env m => Maybe PvpBounds -- ^ Override Config value -> Path Abs Dir -- ^ Path to local package -> m (FilePath, L.ByteString) -- ^ Filename and tarball contents getSDistTarball mpvpBounds pkgDir = do config <- asks getConfig let pvpBounds = fromMaybe (configPvpBounds config) mpvpBounds tweakCabal = pvpBounds /= PvpBoundsNone pkgFp = toFilePath pkgDir lp <- readLocalPackage pkgDir $logInfo $ "Getting file list for " <> T.pack pkgFp (fileList, cabalfp) <- getSDistFileList lp $logInfo $ "Building sdist tarball for " <> T.pack pkgFp files <- normalizeTarballPaths (lines fileList) -- NOTE: Could make this use lazy I/O to only read files as needed -- for upload (both GZip.compress and Tar.write are lazy). -- However, it seems less error prone and more predictable to read -- everything in at once, so that's what we're doing for now: let tarPath isDir fp = either error id (Tar.toTarPath isDir (pkgId FP. fp)) packWith f isDir fp = liftIO $ f (pkgFp FP. fp) (tarPath isDir fp) packDir = packWith Tar.packDirectoryEntry True packFile fp | tweakCabal && isCabalFp fp = do lbs <- getCabalLbs pvpBounds $ toFilePath cabalfp return $ Tar.fileEntry (tarPath False fp) lbs | otherwise = packWith packFileEntry False fp isCabalFp fp = toFilePath pkgDir FP. fp == toFilePath cabalfp tarName = pkgId FP.<.> "tar.gz" pkgId = packageIdentifierString (packageIdentifier (lpPackage lp)) dirEntries <- mapM packDir (dirsFromFiles files) fileEntries <- mapM packFile files return (tarName, GZip.compress (Tar.write (dirEntries ++ fileEntries))) -- | Get the PVP bounds-enabled version of the given cabal file getCabalLbs :: M env m => PvpBounds -> FilePath -> m L.ByteString getCabalLbs pvpBounds fp = do bs <- liftIO $ S.readFile fp (_warnings, gpd) <- readPackageUnresolvedBS Nothing bs (_, _, _, _, sourceMap) <- loadSourceMap AllowNoTargets defaultBuildOptsCLI menv <- getMinimalEnvOverride (installedMap, _, _, _) <- getInstalled menv GetInstalledOpts { getInstalledProfiling = False , getInstalledHaddock = False } sourceMap let gpd' = gtraverseT (addBounds sourceMap installedMap) gpd return $ TLE.encodeUtf8 $ TL.pack $ showGenericPackageDescription gpd' where addBounds :: SourceMap -> InstalledMap -> Dependency -> Dependency addBounds sourceMap installedMap dep@(Dependency cname range) = case lookupVersion (fromCabalPackageName cname) of Nothing -> dep Just version -> Dependency cname $ simplifyVersionRange $ (if toAddUpper && not (hasUpper range) then addUpper version else id) $ (if toAddLower && not (hasLower range) then addLower version else id) range where lookupVersion name = case Map.lookup name sourceMap of Just (PSLocal lp) -> Just $ packageVersion $ lpPackage lp Just (PSUpstream version _ _ _ _) -> Just version Nothing -> case Map.lookup name installedMap of Just (_, installed) -> Just (installedVersion installed) Nothing -> Nothing addUpper version = intersectVersionRanges (earlierVersion $ toCabalVersion $ nextMajorVersion version) addLower version = intersectVersionRanges (orLaterVersion (toCabalVersion version)) (toAddLower, toAddUpper) = case pvpBounds of PvpBoundsNone -> (False, False) PvpBoundsUpper -> (False, True) PvpBoundsLower -> (True, False) PvpBoundsBoth -> (True, True) -- | Traverse a data type. gtraverseT :: (Data a,Typeable b) => (Typeable b => b -> b) -> a -> a gtraverseT f = gmapT (\x -> case cast x of Nothing -> gtraverseT f x Just b -> fromMaybe x (cast (f b))) -- | Read in a 'LocalPackage' config. This makes some default decisions -- about 'LocalPackage' fields that might not be appropriate for other -- use-cases. readLocalPackage :: M env m => Path Abs Dir -> m LocalPackage readLocalPackage pkgDir = do cabalfp <- findOrGenerateCabalFile pkgDir config <- getDefaultPackageConfig (warnings,package) <- readPackage config cabalfp mapM_ (printCabalFileWarning cabalfp) warnings return LocalPackage { lpPackage = package , lpWanted = False -- HACK: makes it so that sdist output goes to a log instead of a file. , lpDir = pkgDir , lpCabalFile = cabalfp -- NOTE: these aren't the 'correct values, but aren't used in -- the usage of this function in this module. , lpTestDeps = Map.empty , lpBenchDeps = Map.empty , lpTestBench = Nothing , lpForceDirty = False , lpDirtyFiles = Nothing , lpNewBuildCache = Map.empty , lpFiles = Set.empty , lpComponents = Set.empty , lpUnbuildable = Set.empty } -- | Returns a newline-separate list of paths, and the absolute path to the .cabal file. getSDistFileList :: M env m => LocalPackage -> m (String, Path Abs File) getSDistFileList lp = withSystemTempDir (stackProgName <> "-sdist") $ \tmpdir -> do menv <- getMinimalEnvOverride let bopts = defaultBuildOpts let boptsCli = defaultBuildOptsCLI baseConfigOpts <- mkBaseConfigOpts boptsCli (_, _mbp, locals, _extraToBuild, _sourceMap) <- loadSourceMap NeedTargets boptsCli runInBase <- liftBaseWith $ \run -> return (void . run) withExecuteEnv menv bopts boptsCli baseConfigOpts locals [] [] [] -- provide empty list of globals. This is a hack around custom Setup.hs files $ \ee -> withSingleContext runInBase ac ee task Nothing (Just "sdist") $ \_package cabalfp _pkgDir cabal _announce _console _mlogFile -> do let outFile = toFilePath tmpdir FP. "source-files-list" cabal False ["sdist", "--list-sources", outFile] contents <- liftIO (readFile outFile) return (contents, cabalfp) where package = lpPackage lp ac = ActionContext Set.empty task = Task { taskProvides = PackageIdentifier (packageName package) (packageVersion package) , taskType = TTLocal lp , taskConfigOpts = TaskConfigOpts { tcoMissing = Set.empty , tcoOpts = \_ -> ConfigureOpts [] [] } , taskPresent = Map.empty , taskAllInOne = True } normalizeTarballPaths :: M env m => [FilePath] -> m [FilePath] normalizeTarballPaths fps = do -- TODO: consider whether erroring out is better - otherwise the -- user might upload an incomplete tar? unless (null outsideDir) $ $logWarn $ T.concat [ "Warning: These files are outside of the package directory, and will be omitted from the tarball: " , T.pack (show outsideDir)] return files where (outsideDir, files) = partitionEithers (map pathToEither fps) pathToEither fp = maybe (Left fp) Right (normalizePath fp) normalizePath :: FilePath -> Maybe FilePath normalizePath = fmap FP.joinPath . go . FP.splitDirectories . FP.normalise where go [] = Just [] go ("..":_) = Nothing go (_:"..":xs) = go xs go (x:xs) = (x :) <$> go xs dirsFromFiles :: [FilePath] -> [FilePath] dirsFromFiles dirs = Set.toAscList (Set.delete "." results) where results = foldl' (\s -> go s . FP.takeDirectory) Set.empty dirs go s x | Set.member x s = s | otherwise = go (Set.insert x s) (FP.takeDirectory x) -- | Check package in given tarball. This will log all warnings -- and will throw an exception in case of critical errors. -- -- Note that we temporarily decompress the archive to analyze it. checkSDistTarball :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasEnvConfig env) => Path Abs File -- ^ Absolute path to tarball -> m () checkSDistTarball tarball = withTempTarGzContents tarball $ \pkgDir' -> do pkgDir <- (pkgDir' ) `liftM` (parseRelDir . FP.takeBaseName . FP.takeBaseName . toFilePath $ tarball) -- ^ drop ".tar" ^ drop ".gz" cabalfp <- findOrGenerateCabalFile pkgDir name <- parsePackageNameFromFilePath cabalfp config <- getDefaultPackageConfig (gdesc, pkgDesc) <- readPackageDescriptionDir config pkgDir $logInfo $ "Checking package '" <> packageNameText name <> "' for common mistakes" let pkgChecks = Check.checkPackage gdesc (Just pkgDesc) fileChecks <- liftIO $ Check.checkPackageFiles pkgDesc (toFilePath pkgDir) let checks = pkgChecks ++ fileChecks (errors, warnings) = let criticalIssue (Check.PackageBuildImpossible _) = True criticalIssue (Check.PackageDistInexcusable _) = True criticalIssue _ = False in partition criticalIssue checks unless (null warnings) $ $logWarn $ "Package check reported the following warnings:\n" <> T.pack (intercalate "\n" . fmap show $ warnings) case NE.nonEmpty errors of Nothing -> return () Just ne -> throwM $ CheckException ne -- | Version of 'checkSDistTarball' that first saves lazy bytestring to -- temporary directory and then calls 'checkSDistTarball' on it. checkSDistTarball' :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasEnvConfig env) => String -- ^ Tarball name -> L.ByteString -- ^ Tarball contents as a byte string -> m () checkSDistTarball' name bytes = withSystemTempDir "stack" $ \tpath -> do npath <- (tpath ) `liftM` parseRelFile name liftIO $ L.writeFile (toFilePath npath) bytes checkSDistTarball npath withTempTarGzContents :: (MonadIO m, MonadMask m) => Path Abs File -- ^ Location of tarball -> (Path Abs Dir -> m a) -- ^ Perform actions given dir with tarball contents -> m a withTempTarGzContents apath f = withSystemTempDir "stack" $ \tpath -> do archive <- liftIO $ L.readFile (toFilePath apath) liftIO . Tar.unpack (toFilePath tpath) . Tar.read . GZip.decompress $ archive f tpath -------------------------------------------------------------------------------- -- Copy+modified from the tar package to avoid issues with lazy IO ( see -- https://github.com/commercialhaskell/stack/issues/1344 ) packFileEntry :: FilePath -- ^ Full path to find the file on the local disk -> Tar.TarPath -- ^ Path to use for the tar Entry in the archive -> IO Tar.Entry packFileEntry filepath tarpath = do mtime <- getModTime filepath perms <- getPermissions filepath content <- S.readFile filepath let size = fromIntegral (S.length content) return (Tar.simpleEntry tarpath (Tar.NormalFile (L.fromStrict content) size)) { Tar.entryPermissions = if executable perms then Tar.executableFilePermissions else Tar.ordinaryFilePermissions, Tar.entryTime = mtime } getModTime :: FilePath -> IO Tar.EpochTime getModTime path = do t <- getModificationTime path return . floor . utcTimeToPOSIXSeconds $ t stack-1.1.2/src/Stack/Setup.hs0000644000000000000000000020346512717707441014322 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TupleSections #-} module Stack.Setup ( setupEnv , ensureCompiler , ensureDockerStackExe , getSystemCompiler , SetupOpts (..) , defaultStackSetupYaml , removeHaskellEnvVars ) where import Control.Applicative import Control.Exception.Enclosed (catchIO, tryAny) import Control.Monad (liftM, when, join, void, unless) import Control.Monad.Catch import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Logger import Control.Monad.Reader (MonadReader, ReaderT (..), asks) import Control.Monad.State (get, put, modify) import Control.Monad.Trans.Control import "cryptohash" Crypto.Hash (SHA1(SHA1)) import Data.Aeson.Extended import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as LBS import Data.Char (isSpace) import Data.Conduit (Conduit, ($$), (=$), await, yield, awaitForever) import Data.Conduit.Lift (evalStateC) import qualified Data.Conduit.List as CL import Data.Either import Data.Foldable hiding (concatMap, or, maximum) import Data.IORef import Data.IORef.RunOnce (runOnce) import Data.List hiding (concat, elem, maximumBy, any) import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe import Data.Monoid import Data.Ord (comparing) import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime) import Data.Typeable (Typeable) import qualified Data.Yaml as Yaml import Distribution.System (OS, Arch (..), Platform (..)) import qualified Distribution.System as Cabal import Distribution.Text (simpleParse) import Lens.Micro (set) import Network.HTTP.Client.Conduit import Network.HTTP.Download.Verified import Path import Path.Extra (toFilePathNoTrailingSep) import Path.IO hiding (findExecutable) import qualified Paths_stack as Meta import Prelude hiding (concat, elem, any) -- Fix AMP warning import Safe (readMay) import Stack.Build (build) import Stack.Config (resolvePackageEntry, loadConfig) import Stack.Constants (distRelativeDir, stackProgName) import Stack.Exec (defaultEnvSettings) import Stack.Fetch import Stack.GhcPkg (createDatabase, getCabalPkgVer, getGlobalDB, mkGhcPackagePath) import Stack.Setup.Installed import Stack.Types import Stack.Types.Internal (HasTerminal, HasReExec, HasLogLevel, envConfigBuildOpts, buildOptsInstallExes) import Stack.Types.StackT import qualified System.Directory as D import System.Environment (getExecutablePath) import System.Exit (ExitCode (ExitSuccess)) import System.FilePath (searchPathSeparator) import qualified System.FilePath as FP import System.Process (rawSystem) import System.Process.Read import System.Process.Run (runCmd, Cmd(..)) import Text.Printf (printf) -- | Default location of the stack-setup.yaml file defaultStackSetupYaml :: String defaultStackSetupYaml = "https://raw.githubusercontent.com/fpco/stackage-content/master/stack/stack-setup-2.yaml" data SetupOpts = SetupOpts { soptsInstallIfMissing :: !Bool , soptsUseSystem :: !Bool , soptsWantedCompiler :: !CompilerVersion , soptsCompilerCheck :: !VersionCheck , soptsStackYaml :: !(Maybe (Path Abs File)) -- ^ If we got the desired GHC version from that file , soptsForceReinstall :: !Bool , soptsSanityCheck :: !Bool -- ^ Run a sanity check on the selected GHC , soptsSkipGhcCheck :: !Bool -- ^ Don't check for a compatible GHC version/architecture , soptsSkipMsys :: !Bool -- ^ Do not use a custom msys installation on Windows , soptsUpgradeCabal :: !Bool -- ^ Upgrade the global Cabal library in the database to the newest -- version. Only works reliably with a stack-managed installation. , soptsResolveMissingGHC :: !(Maybe Text) -- ^ Message shown to user for how to resolve the missing GHC , soptsStackSetupYaml :: !FilePath -- ^ Location of the main stack-setup.yaml file , soptsGHCBindistURL :: !(Maybe String) -- ^ Alternate GHC binary distribution (requires custom GHCVariant) } deriving Show data SetupException = UnsupportedSetupCombo OS Arch | MissingDependencies [String] | UnknownCompilerVersion Text CompilerVersion [CompilerVersion] | UnknownOSKey Text | GHCSanityCheckCompileFailed ReadProcessException (Path Abs File) | WantedMustBeGHC | RequireCustomGHCVariant | ProblemWhileDecompressing (Path Abs File) | SetupInfoMissingSevenz | GHCJSRequiresStandardVariant | GHCJSNotBooted | DockerStackExeNotFound Version Text deriving Typeable instance Exception SetupException instance Show SetupException where show (UnsupportedSetupCombo os arch) = concat [ "I don't know how to install GHC for " , show (os, arch) , ", please install manually" ] show (MissingDependencies tools) = "The following executables are missing and must be installed: " ++ intercalate ", " tools show (UnknownCompilerVersion oskey wanted known) = concat [ "No information found for " , compilerVersionString wanted , ".\nSupported versions for OS key '" ++ T.unpack oskey ++ "': " , intercalate ", " (map show known) ] show (UnknownOSKey oskey) = "Unable to find installation URLs for OS key: " ++ T.unpack oskey show (GHCSanityCheckCompileFailed e ghc) = concat [ "The GHC located at " , toFilePath ghc , " failed to compile a sanity check. Please see:\n\n" , " http://docs.haskellstack.org/en/stable/install_and_upgrade/\n\n" , "for more information. Exception was:\n" , show e ] show WantedMustBeGHC = "The wanted compiler must be GHC" show RequireCustomGHCVariant = "A custom --ghc-variant must be specified to use --ghc-bindist" show (ProblemWhileDecompressing archive) = "Problem while decompressing " ++ toFilePath archive show SetupInfoMissingSevenz = "SetupInfo missing Sevenz EXE/DLL" show GHCJSRequiresStandardVariant = "stack does not yet support using --ghc-variant with GHCJS" show GHCJSNotBooted = "GHCJS does not yet have its boot packages installed. Use \"stack setup\" to attempt to run ghcjs-boot." show (DockerStackExeNotFound stackVersion osKey) = concat [ stackProgName , "-" , versionString stackVersion , " executable not found for " , T.unpack osKey , "\nUse the '" , T.unpack dockerStackExeArgName , "' option to specify a location"] -- | Modify the environment variables (like PATH) appropriately, possibly doing installation too setupEnv :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasBuildConfig env, HasHttpManager env, HasTerminal env, HasReExec env, HasLogLevel env, HasGHCVariant env, MonadBaseControl IO m) => Maybe Text -- ^ Message to give user when necessary GHC is not available -> m EnvConfig setupEnv mResolveMissingGHC = do bconfig <- asks getBuildConfig let platform = getPlatform bconfig wc = whichCompiler (bcWantedCompiler bconfig) sopts = SetupOpts { soptsInstallIfMissing = configInstallGHC $ bcConfig bconfig , soptsUseSystem = configSystemGHC $ bcConfig bconfig , soptsWantedCompiler = bcWantedCompiler bconfig , soptsCompilerCheck = configCompilerCheck $ bcConfig bconfig , soptsStackYaml = Just $ bcStackYaml bconfig , soptsForceReinstall = False , soptsSanityCheck = False , soptsSkipGhcCheck = configSkipGHCCheck $ bcConfig bconfig , soptsSkipMsys = configSkipMsys $ bcConfig bconfig , soptsUpgradeCabal = False , soptsResolveMissingGHC = mResolveMissingGHC , soptsStackSetupYaml = defaultStackSetupYaml , soptsGHCBindistURL = Nothing } mghcBin <- ensureCompiler sopts -- Modify the initial environment to include the GHC path, if a local GHC -- is being used menv0 <- getMinimalEnvOverride env <- removeHaskellEnvVars <$> augmentPathMap (maybe [] edBins mghcBin) (unEnvOverride menv0) menv <- mkEnvOverride platform env compilerVer <- getCompilerVersion menv wc cabalVer <- getCabalPkgVer menv wc $logDebug "Resolving package entries" packages <- mapM (resolvePackageEntry menv (bcRoot bconfig)) (bcPackageEntries bconfig) let envConfig0 = EnvConfig { envConfigBuildConfig = bconfig , envConfigCabalVersion = cabalVer , envConfigCompilerVersion = compilerVer , envConfigPackages = Map.fromList $ concat packages } -- extra installation bin directories mkDirs <- runReaderT extraBinDirs envConfig0 let mpath = Map.lookup "PATH" env mkDirs' = map toFilePath . mkDirs depsPath <- augmentPath (mkDirs' False) mpath localsPath <- augmentPath (mkDirs' True) mpath deps <- runReaderT packageDatabaseDeps envConfig0 createDatabase menv wc deps localdb <- runReaderT packageDatabaseLocal envConfig0 createDatabase menv wc localdb globaldb <- getGlobalDB menv wc extras <- runReaderT packageDatabaseExtra envConfig0 let mkGPP locals = mkGhcPackagePath locals localdb deps extras globaldb distDir <- runReaderT distRelativeDir envConfig0 executablePath <- liftIO getExecutablePath utf8EnvVars <- getUtf8EnvVars menv compilerVer envRef <- liftIO $ newIORef Map.empty let getEnvOverride' es = do m <- readIORef envRef case Map.lookup es m of Just eo -> return eo Nothing -> do eo <- mkEnvOverride platform $ Map.insert "PATH" (if esIncludeLocals es then localsPath else depsPath) $ (if esIncludeGhcPackagePath es then Map.insert (case wc of { Ghc -> "GHC_PACKAGE_PATH"; Ghcjs -> "GHCJS_PACKAGE_PATH" }) (mkGPP (esIncludeLocals es)) else id) $ (if esStackExe es then Map.insert "STACK_EXE" (T.pack executablePath) else id) $ (if esLocaleUtf8 es then Map.union utf8EnvVars else id) $ case (soptsSkipMsys sopts, platform) of (False, Platform Cabal.I386 Cabal.Windows) -> Map.insert "MSYSTEM" "MINGW32" (False, Platform Cabal.X86_64 Cabal.Windows) -> Map.insert "MSYSTEM" "MINGW64" _ -> id -- For reasoning and duplication, see: https://github.com/fpco/stack/issues/70 $ Map.insert "HASKELL_PACKAGE_SANDBOX" (T.pack $ toFilePathNoTrailingSep deps) $ Map.insert "HASKELL_PACKAGE_SANDBOXES" (T.pack $ if esIncludeLocals es then intercalate [searchPathSeparator] [ toFilePathNoTrailingSep localdb , toFilePathNoTrailingSep deps , "" ] else intercalate [searchPathSeparator] [ toFilePathNoTrailingSep deps , "" ]) $ Map.insert "HASKELL_DIST_DIR" (T.pack $ toFilePathNoTrailingSep distDir) env () <- atomicModifyIORef envRef $ \m' -> (Map.insert es eo m', ()) return eo return EnvConfig { envConfigBuildConfig = bconfig { bcConfig = maybe id addIncludeLib mghcBin (bcConfig bconfig) { configEnvOverride = getEnvOverride' } } , envConfigCabalVersion = cabalVer , envConfigCompilerVersion = compilerVer , envConfigPackages = envConfigPackages envConfig0 } -- | Add the include and lib paths to the given Config addIncludeLib :: ExtraDirs -> Config -> Config addIncludeLib (ExtraDirs _bins includes libs) config = config { configExtraIncludeDirs = Set.union (configExtraIncludeDirs config) (Set.fromList $ map T.pack includes) , configExtraLibDirs = Set.union (configExtraLibDirs config) (Set.fromList $ map T.pack libs) } -- | Ensure compiler (ghc or ghcjs) is installed and provide the PATHs to add if necessary ensureCompiler :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, HasTerminal env, HasReExec env, HasLogLevel env, HasGHCVariant env, MonadBaseControl IO m) => SetupOpts -> m (Maybe ExtraDirs) ensureCompiler sopts = do let wc = whichCompiler (soptsWantedCompiler sopts) when (getGhcVersion (soptsWantedCompiler sopts) < $(mkVersion "7.8")) $ do $logWarn "stack will almost certainly fail with GHC below version 7.8" $logWarn "Valiantly attempting to run anyway, but I know this is doomed" $logWarn "For more information, see: https://github.com/commercialhaskell/stack/issues/648" $logWarn "" -- Check the available GHCs menv0 <- getMinimalEnvOverride msystem <- if soptsUseSystem sopts then do $logDebug "Getting system compiler version" getSystemCompiler menv0 wc else return Nothing Platform expectedArch _ <- asks getPlatform let needLocal = case msystem of Nothing -> True Just _ | soptsSkipGhcCheck sopts -> False Just (system, arch) -> not (isWanted system) || arch /= expectedArch isWanted = isWantedCompiler (soptsCompilerCheck sopts) (soptsWantedCompiler sopts) -- If we need to install a GHC or MSYS, try to do so -- Return the additional directory paths of GHC & MSYS. mtools <- if needLocal then do getSetupInfo' <- runOnce (getSetupInfo (soptsStackSetupYaml sopts) =<< asks getHttpManager) localPrograms <- asks $ configLocalPrograms . getConfig installed <- listInstalled localPrograms -- Install GHC ghcVariant <- asks getGHCVariant config <- asks getConfig ghcPkgName <- parsePackageNameFromString ("ghc" ++ ghcVariantSuffix ghcVariant) let installedCompiler = case wc of Ghc -> getInstalledTool installed ghcPkgName (isWanted . GhcVersion) Ghcjs -> getInstalledGhcjs installed isWanted compilerTool <- case installedCompiler of Just tool -> return tool Nothing | soptsInstallIfMissing sopts -> do si <- getSetupInfo' downloadAndInstallCompiler si (soptsWantedCompiler sopts) (soptsCompilerCheck sopts) (soptsGHCBindistURL sopts) | otherwise -> throwM $ CompilerVersionMismatch msystem (soptsWantedCompiler sopts, expectedArch) ghcVariant (soptsCompilerCheck sopts) (soptsStackYaml sopts) (fromMaybe ("Try running \"stack setup\" to install the correct GHC into " <> T.pack (toFilePath (configLocalPrograms config))) $ soptsResolveMissingGHC sopts) -- Install msys2 on windows, if necessary platform <- asks getPlatform mmsys2Tool <- case platform of Platform _ Cabal.Windows | not (soptsSkipMsys sopts) -> case getInstalledTool installed $(mkPackageName "msys2") (const True) of Just tool -> return (Just tool) Nothing | soptsInstallIfMissing sopts -> do si <- getSetupInfo' osKey <- getOSKey platform VersionedDownloadInfo version info <- case Map.lookup osKey $ siMsys2 si of Just x -> return x Nothing -> error $ "MSYS2 not found for " ++ T.unpack osKey let tool = Tool (PackageIdentifier $(mkPackageName "msys2") version) Just <$> downloadAndInstallTool (configLocalPrograms config) si info tool (installMsys2Windows osKey) | otherwise -> do $logWarn "Continuing despite missing tool: msys2" return Nothing _ -> return Nothing return $ Just (compilerTool, mmsys2Tool) else return Nothing mpaths <- case mtools of Nothing -> return Nothing Just (compilerTool, mmsys2Tool) -> do -- Add GHC's and MSYS's paths to the config. let idents = catMaybes [Just compilerTool, mmsys2Tool] paths <- mapM extraDirs idents return $ Just $ mconcat paths menv <- case mpaths of Nothing -> return menv0 Just ed -> do config <- asks getConfig m <- augmentPathMap (edBins ed) (unEnvOverride menv0) mkEnvOverride (configPlatform config) (removeHaskellEnvVars m) when (soptsUpgradeCabal sopts) $ do unless needLocal $ do $logWarn "Trying to upgrade Cabal library on a GHC not installed by stack." $logWarn "This may fail, caveat emptor!" upgradeCabal menv wc case mtools of Just (ToolGhcjs cv, _) -> ensureGhcjsBooted menv cv (soptsInstallIfMissing sopts) _ -> return () when (soptsSanityCheck sopts) $ sanityCheck menv wc return mpaths -- Ensure Docker container-compatible 'stack' executable is downloaded ensureDockerStackExe :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, MonadBaseControl IO m) => Platform -> m (Path Abs File) ensureDockerStackExe containerPlatform = do config <- asks getConfig containerPlatformDir <- runReaderT platformOnlyRelDir (containerPlatform,PlatformVariantNone) let programsPath = configLocalProgramsBase config containerPlatformDir stackVersion = fromCabalVersion Meta.version tool = Tool (PackageIdentifier $(mkPackageName "stack") stackVersion) stackExePath <- ( $(mkRelFile "stack")) <$> installDir programsPath tool stackExeExists <- doesFileExist stackExePath unless stackExeExists $ do $logInfo $ mconcat ["Downloading Docker-compatible ", T.pack stackProgName, " executable"] si <- getSetupInfo defaultStackSetupYaml =<< asks getHttpManager osKey <- getOSKey containerPlatform info <- case Map.lookup osKey (siStack si) of Just versions -> case Map.lookup stackVersion versions of Just x -> return x Nothing -> throwM (DockerStackExeNotFound stackVersion osKey) Nothing -> throwM (DockerStackExeNotFound stackVersion osKey) _ <- downloadAndInstallTool programsPath si info tool installDockerStackExe return () return stackExePath -- | Install the newest version of Cabal globally upgradeCabal :: (MonadIO m, MonadLogger m, MonadReader env m, HasHttpManager env, HasConfig env, MonadBaseControl IO m, MonadMask m) => EnvOverride -> WhichCompiler -> m () upgradeCabal menv wc = do let name = $(mkPackageName "Cabal") rmap <- resolvePackages menv Map.empty (Set.singleton name) newest <- case Map.keys rmap of [] -> error "No Cabal library found in index, cannot upgrade" [PackageIdentifier name' version] | name == name' -> return version x -> error $ "Unexpected results for resolvePackages: " ++ show x installed <- getCabalPkgVer menv wc if installed >= newest then $logInfo $ T.concat [ "Currently installed Cabal is " , T.pack $ versionString installed , ", newest is " , T.pack $ versionString newest , ". I'm not upgrading Cabal." ] else withSystemTempDir "stack-cabal-upgrade" $ \tmpdir -> do $logInfo $ T.concat [ "Installing Cabal-" , T.pack $ versionString newest , " to replace " , T.pack $ versionString installed ] let ident = PackageIdentifier name newest -- Nothing below: use the newest .cabal file revision m <- unpackPackageIdents menv tmpdir Nothing (Map.singleton ident Nothing) compilerPath <- join $ findExecutable menv (compilerExeName wc) newestDir <- parseRelDir $ versionString newest let installRoot = toFilePath $ parent (parent compilerPath) $(mkRelDir "new-cabal") newestDir dir <- case Map.lookup ident m of Nothing -> error "upgradeCabal: Invariant violated, dir missing" Just dir -> return dir runCmd (Cmd (Just dir) (compilerExeName wc) menv ["Setup.hs"]) Nothing platform <- asks getPlatform let setupExe = toFilePath $ dir (case platform of Platform _ Cabal.Windows -> $(mkRelFile "Setup.exe") _ -> $(mkRelFile "Setup")) dirArgument name' = concat [ "--" , name' , "dir=" , installRoot FP. name' ] args = ( "configure": map dirArgument (words "lib bin data doc") ) runCmd (Cmd (Just dir) setupExe menv args) Nothing runCmd (Cmd (Just dir) setupExe menv ["build"]) Nothing runCmd (Cmd (Just dir) setupExe menv ["install"]) Nothing $logInfo "New Cabal library installed" -- | Get the version of the system compiler, if available getSystemCompiler :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> WhichCompiler -> m (Maybe (CompilerVersion, Arch)) getSystemCompiler menv wc = do let exeName = case wc of Ghc -> "ghc" Ghcjs -> "ghcjs" exists <- doesExecutableExist menv exeName if exists then do eres <- tryProcessStdout Nothing menv exeName ["--info"] let minfo = do Right bs <- Just eres pairs_ <- readMay $ S8.unpack bs :: Maybe [(String, String)] version <- lookup "Project version" pairs_ >>= parseVersionFromString arch <- lookup "Target platform" pairs_ >>= simpleParse . takeWhile (/= '-') return (version, arch) case (wc, minfo) of (Ghc, Just (version, arch)) -> return (Just (GhcVersion version, arch)) (Ghcjs, Just (_, arch)) -> do eversion <- tryAny $ getCompilerVersion menv Ghcjs case eversion of Left _ -> return Nothing Right version -> return (Just (version, arch)) (_, Nothing) -> return Nothing else return Nothing -- | Download the most recent SetupInfo getSetupInfo :: (MonadIO m, MonadThrow m, MonadLogger m, MonadReader env m, HasConfig env) => String -> Manager -> m SetupInfo getSetupInfo stackSetupYaml manager = do config <- asks getConfig setupInfos <- mapM loadSetupInfo (SetupInfoFileOrURL stackSetupYaml : configSetupInfoLocations config) return (mconcat setupInfos) where loadSetupInfo (SetupInfoInline si) = return si loadSetupInfo (SetupInfoFileOrURL urlOrFile) = do bs <- case parseUrl urlOrFile of Just req -> do bss <- liftIO $ flip runReaderT manager $ withResponse req $ \res -> responseBody res $$ CL.consume return $ S8.concat bss Nothing -> liftIO $ S.readFile urlOrFile WithJSONWarnings si warnings <- either throwM return (Yaml.decodeEither' bs) when (urlOrFile /= defaultStackSetupYaml) $ logJSONWarnings urlOrFile warnings return si getInstalledTool :: [Tool] -- ^ already installed -> PackageName -- ^ package to find -> (Version -> Bool) -- ^ which versions are acceptable -> Maybe Tool getInstalledTool installed name goodVersion = if null available then Nothing else Just $ Tool $ maximumBy (comparing packageIdentifierVersion) available where available = mapMaybe goodPackage installed goodPackage (Tool pi') = if packageIdentifierName pi' == name && goodVersion (packageIdentifierVersion pi') then Just pi' else Nothing goodPackage _ = Nothing getInstalledGhcjs :: [Tool] -> (CompilerVersion -> Bool) -> Maybe Tool getInstalledGhcjs installed goodVersion = if null available then Nothing else Just $ ToolGhcjs $ maximum available where available = mapMaybe goodPackage installed goodPackage (ToolGhcjs cv) = if goodVersion cv then Just cv else Nothing goodPackage _ = Nothing downloadAndInstallTool :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, MonadBaseControl IO m) => Path Abs Dir -> SetupInfo -> DownloadInfo -> Tool -> (SetupInfo -> Path Abs File -> ArchiveType -> Path Abs Dir -> m ()) -> m Tool downloadAndInstallTool programsDir si downloadInfo tool installer = do (file, at) <- downloadFromInfo programsDir downloadInfo tool dir <- installDir programsDir tool unmarkInstalled programsDir tool installer si file at dir markInstalled programsDir tool return tool downloadAndInstallCompiler :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasGHCVariant env, HasHttpManager env, HasTerminal env, HasReExec env, HasLogLevel env, MonadBaseControl IO m) => SetupInfo -> CompilerVersion -> VersionCheck -> Maybe String -> m Tool downloadAndInstallCompiler si wanted@(GhcVersion{}) versionCheck mbindistURL = do ghcVariant <- asks getGHCVariant (selectedVersion, downloadInfo) <- case mbindistURL of Just bindistURL -> do case ghcVariant of GHCCustom _ -> return () _ -> throwM RequireCustomGHCVariant case wanted of GhcVersion version -> return (version, DownloadInfo (T.pack bindistURL) Nothing Nothing) _ -> throwM WantedMustBeGHC _ -> do ghcKey <- getGhcKey case Map.lookup ghcKey $ siGHCs si of Nothing -> throwM $ UnknownOSKey ghcKey Just pairs_ -> getWantedCompilerInfo ghcKey versionCheck wanted GhcVersion pairs_ config <- asks getConfig let installer = case configPlatform config of Platform _ Cabal.Windows -> installGHCWindows selectedVersion _ -> installGHCPosix selectedVersion $logInfo $ "Preparing to install GHC" <> (case ghcVariant of GHCStandard -> "" v -> " (" <> T.pack (ghcVariantName v) <> ")") <> " to an isolated location." $logInfo "This will not interfere with any system-level installation." ghcPkgName <- parsePackageNameFromString ("ghc" ++ ghcVariantSuffix ghcVariant) let tool = Tool $ PackageIdentifier ghcPkgName selectedVersion downloadAndInstallTool (configLocalPrograms config) si downloadInfo tool installer downloadAndInstallCompiler si wanted versionCheck _mbindistUrl = do config <- asks getConfig ghcVariant <- asks getGHCVariant case ghcVariant of GHCStandard -> return () _ -> throwM GHCJSRequiresStandardVariant (selectedVersion, downloadInfo) <- case Map.lookup "source" $ siGHCJSs si of Nothing -> throwM $ UnknownOSKey "source" Just pairs_ -> getWantedCompilerInfo "source" versionCheck wanted id pairs_ $logInfo "Preparing to install GHCJS to an isolated location." $logInfo "This will not interfere with any system-level installation." let tool = ToolGhcjs selectedVersion downloadAndInstallTool (configLocalPrograms config) si downloadInfo tool installGHCJS getWantedCompilerInfo :: (Ord k, MonadThrow m) => Text -> VersionCheck -> CompilerVersion -> (k -> CompilerVersion) -> Map k a -> m (k, a) getWantedCompilerInfo key versionCheck wanted toCV pairs_ = case mpair of Just pair -> return pair Nothing -> throwM $ UnknownCompilerVersion key wanted (map toCV (Map.keys pairs_)) where mpair = listToMaybe $ sortBy (flip (comparing fst)) $ filter (isWantedCompiler versionCheck wanted . toCV . fst) (Map.toList pairs_) getGhcKey :: (MonadReader env m, HasPlatform env, HasGHCVariant env, MonadCatch m) => m Text getGhcKey = do ghcVariant <- asks getGHCVariant platform <- asks getPlatform osKey <- getOSKey platform return $ osKey <> T.pack (ghcVariantSuffix ghcVariant) getOSKey :: (MonadThrow m) => Platform -> m Text getOSKey platform = case platform of Platform I386 Cabal.Linux -> return "linux32" Platform X86_64 Cabal.Linux -> return "linux64" Platform I386 Cabal.OSX -> return "macosx" Platform X86_64 Cabal.OSX -> return "macosx" Platform I386 Cabal.FreeBSD -> return "freebsd32" Platform X86_64 Cabal.FreeBSD -> return "freebsd64" Platform I386 Cabal.OpenBSD -> return "openbsd32" Platform X86_64 Cabal.OpenBSD -> return "openbsd64" Platform I386 Cabal.Windows -> return "windows32" Platform X86_64 Cabal.Windows -> return "windows64" Platform arch os -> throwM $ UnsupportedSetupCombo os arch downloadFromInfo :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, MonadBaseControl IO m) => Path Abs Dir -> DownloadInfo -> Tool -> m (Path Abs File, ArchiveType) downloadFromInfo programsDir downloadInfo tool = do at <- case extension of ".tar.xz" -> return TarXz ".tar.bz2" -> return TarBz2 ".tar.gz" -> return TarGz ".7z.exe" -> return SevenZ _ -> error $ "Unknown extension for url: " ++ T.unpack url relfile <- parseRelFile $ toolString tool ++ extension let path = programsDir relfile chattyDownload (T.pack (toolString tool)) downloadInfo path return (path, at) where url = downloadInfoUrl downloadInfo extension = loop $ T.unpack url where loop fp | ext `elem` [".tar", ".bz2", ".xz", ".exe", ".7z", ".gz"] = loop fp' ++ ext | otherwise = "" where (fp', ext) = FP.splitExtension fp data ArchiveType = TarBz2 | TarXz | TarGz | SevenZ installGHCPosix :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, MonadBaseControl IO m) => Version -> SetupInfo -> Path Abs File -> ArchiveType -> Path Abs Dir -> m () installGHCPosix version _ archiveFile archiveType destDir = do platform <- asks getPlatform menv0 <- getMinimalEnvOverride menv <- mkEnvOverride platform (removeHaskellEnvVars (unEnvOverride menv0)) $logDebug $ "menv = " <> T.pack (show (unEnvOverride menv)) zipTool' <- case archiveType of TarXz -> return "xz" TarBz2 -> return "bzip2" TarGz -> return "gzip" SevenZ -> error "Don't know how to deal with .7z files on non-Windows" (zipTool, makeTool, tarTool) <- checkDependencies $ (,,) <$> checkDependency zipTool' <*> (checkDependency "gmake" <|> checkDependency "make") <*> checkDependency "tar" $logDebug $ "ziptool: " <> T.pack zipTool $logDebug $ "make: " <> T.pack makeTool $logDebug $ "tar: " <> T.pack tarTool withSystemTempDir "stack-setup" $ \root -> do dir <- liftM (root ) $ parseRelDir $ "ghc-" ++ versionString version $logSticky $ T.concat ["Unpacking GHC into ", T.pack . toFilePath $ root, " ..."] $logDebug $ "Unpacking " <> T.pack (toFilePath archiveFile) readInNull root tarTool menv ["xf", toFilePath archiveFile] Nothing $logSticky "Configuring GHC ..." readInNull dir (toFilePath $ dir $(mkRelFile "configure")) menv ["--prefix=" ++ toFilePath destDir] Nothing $logSticky "Installing GHC ..." readInNull dir makeTool menv ["install"] Nothing $logStickyDone $ "Installed GHC." $logDebug $ "GHC installed to " <> T.pack (toFilePath destDir) installGHCJS :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, HasTerminal env, HasReExec env, HasLogLevel env, MonadBaseControl IO m) => SetupInfo -> Path Abs File -> ArchiveType -> Path Abs Dir -> m () installGHCJS si archiveFile archiveType destDir = do platform <- asks getPlatform menv0 <- getMinimalEnvOverride -- This ensures that locking is disabled for the invocations of -- stack below. let removeLockVar = Map.delete "STACK_LOCK" menv <- mkEnvOverride platform (removeLockVar (removeHaskellEnvVars (unEnvOverride menv0))) $logDebug $ "menv = " <> T.pack (show (unEnvOverride menv)) -- NOTE: this is a bit of a hack - instead of using a temp -- directory, leave the unpacked source tarball in the destination -- directory. This way, the absolute paths in the wrapper scripts -- will point to executables that exist in -- src/.stack-work/install/... - see -- https://github.com/commercialhaskell/stack/issues/1016 -- -- This is also used by 'ensureGhcjsBooted', because it can use the -- environment of the stack.yaml which came with ghcjs, in order to -- install cabal-install. This lets us also fix the version of -- cabal-install used. let unpackDir = destDir $(mkRelDir "src") runUnpack <- case platform of Platform _ Cabal.Windows -> return $ withUnpackedTarball7z "GHCJS" si archiveFile archiveType Nothing unpackDir _ -> do zipTool' <- case archiveType of TarXz -> return "xz" TarBz2 -> return "bzip2" TarGz -> return "gzip" SevenZ -> error "Don't know how to deal with .7z files on non-Windows" (zipTool, tarTool) <- checkDependencies $ (,) <$> checkDependency zipTool' <*> checkDependency "tar" $logDebug $ "ziptool: " <> T.pack zipTool $logDebug $ "tar: " <> T.pack tarTool return $ do ignoringAbsence (removeDirRecur destDir) ignoringAbsence (removeDirRecur unpackDir) readInNull destDir tarTool menv ["xf", toFilePath archiveFile] Nothing innerDir <- expectSingleUnpackedDir archiveFile destDir renameDir innerDir unpackDir $logSticky $ T.concat ["Unpacking GHCJS into ", T.pack . toFilePath $ unpackDir, " ..."] $logDebug $ "Unpacking " <> T.pack (toFilePath archiveFile) runUnpack $logSticky "Setting up GHCJS build environment" let stackYaml = unpackDir $(mkRelFile "stack.yaml") destBinDir = destDir $(mkRelDir "bin") ensureDir destBinDir envConfig' <- loadGhcjsEnvConfig stackYaml destBinDir -- On windows we need to copy options files out of the install dir. Argh! -- This is done before the build, so that if it fails, things fail -- earlier. mwindowsInstallDir <- case platform of Platform _ Cabal.Windows -> liftM Just $ runInnerStackT envConfig' installationRootLocal _ -> return Nothing $logSticky "Installing GHCJS (this will take a long time) ..." runInnerStackT ((set (envConfigBuildOpts.buildOptsInstallExes) True envConfig')) $ (build (\_ -> return ()) Nothing defaultBuildOptsCLI) -- Copy over *.options files needed on windows. forM_ mwindowsInstallDir $ \dir -> do (_, files) <- listDir (dir $(mkRelDir "bin")) forM_ (filter ((".options" `isSuffixOf`). toFilePath) files) $ \optionsFile -> do let dest = destDir $(mkRelDir "bin") filename optionsFile ignoringAbsence (removeFile dest) copyFile optionsFile dest $logStickyDone "Installed GHCJS." -- Install the downloaded stack binary distribution installDockerStackExe :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, MonadBaseControl IO m) => SetupInfo -> Path Abs File -> ArchiveType -> Path Abs Dir -> m () installDockerStackExe _ archiveFile _ destDir = do (_,tarTool) <- checkDependencies $ (,) <$> checkDependency "gzip" <*> checkDependency "tar" menv <- getMinimalEnvOverride ensureDir destDir readInNull destDir tarTool menv ["xf", toFilePath archiveFile, "--strip-components", "1"] Nothing ensureGhcjsBooted :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, MonadCatch m, HasConfig env, HasHttpManager env, HasTerminal env, HasReExec env, HasLogLevel env, MonadReader env m) => EnvOverride -> CompilerVersion -> Bool -> m () ensureGhcjsBooted menv cv shouldBoot = do eres <- try $ sinkProcessStdout Nothing menv "ghcjs" [] (return ()) case eres of Right () -> return () Left (ReadProcessException _ _ _ err) | "no input files" `S.isInfixOf` LBS.toStrict err -> return () Left (ReadProcessException _ _ _ err) | "ghcjs_boot.completed" `S.isInfixOf` LBS.toStrict err -> if not shouldBoot then throwM GHCJSNotBooted else do config <- asks getConfig destDir <- installDir (configLocalPrograms config) (ToolGhcjs cv) let stackYaml = destDir $(mkRelFile "src/stack.yaml") -- TODO: Remove 'actualStackYaml' and just use -- 'stackYaml' for a version after 0.1.6. It's for -- compatibility with the directories setup used for -- most of the life of the development branch between -- 0.1.5 and 0.1.6. See -- https://github.com/commercialhaskell/stack/issues/749#issuecomment-147382783 -- This only affects the case where GHCJS has been -- installed with an older version and not yet booted. stackYamlExists <- doesFileExist stackYaml ghcjsVersion <- case cv of GhcjsVersion version _ -> return version _ -> fail "ensureGhcjsBooted invoked on non GhcjsVersion" actualStackYaml <- if stackYamlExists then return stackYaml else liftM ((destDir $(mkRelDir "src")) ) $ parseRelFile $ "ghcjs-" ++ versionString ghcjsVersion ++ "/stack.yaml" actualStackYamlExists <- doesFileExist actualStackYaml unless actualStackYamlExists $ fail "Couldn't find GHCJS stack.yaml in old or new location." bootGhcjs ghcjsVersion actualStackYaml destDir Left err -> throwM err bootGhcjs :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, MonadCatch m, HasHttpManager env, HasTerminal env, HasReExec env, HasLogLevel env, MonadReader env m) => Version -> Path Abs File -> Path Abs Dir -> m () bootGhcjs ghcjsVersion stackYaml destDir = do envConfig <- loadGhcjsEnvConfig stackYaml (destDir $(mkRelDir "bin")) menv <- liftIO $ configEnvOverride (getConfig envConfig) defaultEnvSettings -- Install cabal-install if missing, or if the installed one is old. mcabal <- getCabalInstallVersion menv shouldInstallCabal <- case mcabal of Nothing -> do $logInfo "No cabal-install binary found for use with GHCJS." return True Just v | v < $(mkVersion "1.22.4") -> do $logInfo $ "The cabal-install found on PATH is too old to be used for booting GHCJS (version " <> versionText v <> ")." return True | v >= $(mkVersion "1.23") -> do $logWarn $ "The cabal-install found on PATH is a version stack doesn't know about, version " <> versionText v <> ". This may or may not work.\n" <> "See this issue: https://github.com/ghcjs/ghcjs/issues/470" return False | ghcjsVersion >= $(mkVersion "0.2.0.20160413") && v >= $(mkVersion "1.22.8") -> do $logWarn $ "The cabal-install found on PATH, version " <> versionText v <> ", is >= 1.22.8.\n" <> "That version has a bug preventing ghcjs < 0.2.0.20160413 from booting.\n" <> "See this issue: https://github.com/ghcjs/ghcjs/issues/470" return True | otherwise -> return False let envSettings = defaultEnvSettings { esIncludeGhcPackagePath = False } menv' <- liftIO $ configEnvOverride (getConfig envConfig) envSettings when shouldInstallCabal $ do $logInfo "Building a local copy of cabal-install from source." runInnerStackT envConfig $ build (\_ -> return ()) Nothing defaultBuildOptsCLI { boptsCLITargets = ["cabal-install"] } mcabal' <- getCabalInstallVersion menv' case mcabal' of Nothing -> $logError $ "Failed to get cabal-install version after installing it.\n" <> "This shouldn't happen, because it gets built to the snapshot bin directory, which should be treated as being on the PATH." Just v | v >= $(mkVersion "1.22.8") && v < $(mkVersion "1.23") -> $logWarn $ "Installed version of cabal-install is in a version range which may not work.\n" <> "See this issue: https://github.com/ghcjs/ghcjs/issues/470\n" <> "This version is specified by the stack.yaml file included in the ghcjs tarball.\n" _ -> return () $logSticky "Booting GHCJS (this will take a long time) ..." logProcessStderrStdout Nothing "ghcjs-boot" menv' ["--clean"] $logStickyDone "GHCJS booted." loadGhcjsEnvConfig :: (MonadIO m, HasHttpManager r, MonadReader r m, HasTerminal r, HasReExec r, HasLogLevel r) => Path Abs File -> Path b t -> m EnvConfig loadGhcjsEnvConfig stackYaml binPath = runInnerStackLoggingT $ do lc <- loadConfig (mempty { configMonoidInstallGHC = First (Just True) , configMonoidLocalBinPath = First (Just (toFilePath binPath)) }) Nothing (Just stackYaml) bconfig <- lcLoadBuildConfig lc Nothing runInnerStackT bconfig $ setupEnv Nothing getCabalInstallVersion :: (MonadIO m, MonadBaseControl IO m, MonadLogger m, MonadCatch m) => EnvOverride -> m (Maybe Version) getCabalInstallVersion menv = do ebs <- tryProcessStdout Nothing menv "cabal" ["--numeric-version"] case ebs of Left _ -> return Nothing Right bs -> Just <$> parseVersion (T.dropWhileEnd isSpace (T.decodeUtf8 bs)) -- | Check if given processes appear to be present, throwing an exception if -- missing. checkDependencies :: (MonadIO m, MonadThrow m, MonadReader env m, HasConfig env) => CheckDependency a -> m a checkDependencies (CheckDependency f) = do menv <- getMinimalEnvOverride liftIO (f menv) >>= either (throwM . MissingDependencies) return checkDependency :: String -> CheckDependency String checkDependency tool = CheckDependency $ \menv -> do exists <- doesExecutableExist menv tool return $ if exists then Right tool else Left [tool] newtype CheckDependency a = CheckDependency (EnvOverride -> IO (Either [String] a)) deriving Functor instance Applicative CheckDependency where pure x = CheckDependency $ \_ -> return (Right x) CheckDependency f <*> CheckDependency x = CheckDependency $ \menv -> do f' <- f menv x' <- x menv return $ case (f', x') of (Left e1, Left e2) -> Left $ e1 ++ e2 (Left e, Right _) -> Left e (Right _, Left e) -> Left e (Right f'', Right x'') -> Right $ f'' x'' instance Alternative CheckDependency where empty = CheckDependency $ \_ -> return $ Left [] CheckDependency x <|> CheckDependency y = CheckDependency $ \menv -> do res1 <- x menv case res1 of Left _ -> y menv Right x' -> return $ Right x' installGHCWindows :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, MonadBaseControl IO m) => Version -> SetupInfo -> Path Abs File -> ArchiveType -> Path Abs Dir -> m () installGHCWindows version si archiveFile archiveType destDir = do tarComponent <- parseRelDir $ "ghc-" ++ versionString version withUnpackedTarball7z "GHC" si archiveFile archiveType (Just tarComponent) destDir $logInfo $ "GHC installed to " <> T.pack (toFilePath destDir) installMsys2Windows :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, MonadBaseControl IO m) => Text -- ^ OS Key -> SetupInfo -> Path Abs File -> ArchiveType -> Path Abs Dir -> m () installMsys2Windows osKey si archiveFile archiveType destDir = do exists <- liftIO $ D.doesDirectoryExist $ toFilePath destDir when exists $ liftIO (D.removeDirectoryRecursive $ toFilePath destDir) `catchIO` \e -> do $logError $ T.pack $ "Could not delete existing msys directory: " ++ toFilePath destDir throwM e msys <- parseRelDir $ "msys" ++ T.unpack (fromMaybe "32" $ T.stripPrefix "windows" osKey) withUnpackedTarball7z "MSYS2" si archiveFile archiveType (Just msys) destDir -- I couldn't find this officially documented anywhere, but you need to run -- the MSYS shell once in order to initialize some pacman stuff. Once that -- run happens, you can just run commands as usual. platform <- asks getPlatform menv0 <- getMinimalEnvOverride newEnv0 <- modifyEnvOverride menv0 $ Map.insert "MSYSTEM" "MSYS" newEnv <- augmentPathMap [toFilePath $ destDir $(mkRelDir "usr") $(mkRelDir "bin")] (unEnvOverride newEnv0) menv <- mkEnvOverride platform newEnv runCmd (Cmd (Just destDir) "sh" menv ["--login", "-c", "true"]) Nothing -- No longer installing git, it's unreliable -- (https://github.com/commercialhaskell/stack/issues/1046) and the -- MSYS2-installed version has bad CRLF defaults. -- -- Install git. We could install other useful things in the future too. -- runCmd (Cmd (Just destDir) "pacman" menv ["-Sy", "--noconfirm", "git"]) Nothing -- | Unpack a compressed tarball using 7zip. Expects a single directory in -- the unpacked results, which is renamed to the destination directory. withUnpackedTarball7z :: (MonadIO m, MonadMask m, MonadLogger m, MonadReader env m, HasConfig env, HasHttpManager env, MonadBaseControl IO m) => String -- ^ Name of tool, used in error messages -> SetupInfo -> Path Abs File -- ^ Path to archive file -> ArchiveType -> Maybe (Path Rel Dir) -- ^ Name of directory expected in archive. If Nothing, expects a single folder. -> Path Abs Dir -- ^ Destination directory. -> m () withUnpackedTarball7z name si archiveFile archiveType msrcDir destDir = do suffix <- case archiveType of TarXz -> return ".xz" TarBz2 -> return ".bz2" TarGz -> return ".gz" _ -> error $ name ++ " must be a tarball file" tarFile <- case T.stripSuffix suffix $ T.pack $ toFilePath archiveFile of Nothing -> error $ "Invalid " ++ name ++ " filename: " ++ show archiveFile Just x -> parseAbsFile $ T.unpack x run7z <- setup7z si let tmpName = toFilePathNoTrailingSep (dirname destDir) ++ "-tmp" ensureDir (parent destDir) withTempDir (parent destDir) tmpName $ \tmpDir -> do ignoringAbsence (removeDirRecur destDir) run7z (parent archiveFile) archiveFile run7z tmpDir tarFile absSrcDir <- case msrcDir of Just srcDir -> return $ tmpDir srcDir Nothing -> expectSingleUnpackedDir archiveFile tmpDir removeFile tarFile `catchIO` \e -> $logWarn (T.concat [ "Exception when removing " , T.pack $ toFilePath tarFile , ": " , T.pack $ show e ]) renameDir absSrcDir destDir expectSingleUnpackedDir :: (MonadIO m, MonadThrow m) => Path Abs File -> Path Abs Dir -> m (Path Abs Dir) expectSingleUnpackedDir archiveFile destDir = do contents <- listDir destDir case contents of ([dir], []) -> return dir _ -> error $ "Expected a single directory within unpacked " ++ toFilePath archiveFile -- | Download 7z as necessary, and get a function for unpacking things. -- -- Returned function takes an unpack directory and archive. setup7z :: (MonadReader env m, HasHttpManager env, HasConfig env, MonadThrow m, MonadIO m, MonadIO n, MonadLogger m, MonadLogger n, MonadBaseControl IO m) => SetupInfo -> m (Path Abs Dir -> Path Abs File -> n ()) setup7z si = do dir <- asks $ configLocalPrograms . getConfig let exe = dir $(mkRelFile "7z.exe") dll = dir $(mkRelFile "7z.dll") case (siSevenzDll si, siSevenzExe si) of (Just sevenzDll, Just sevenzExe) -> do chattyDownload "7z.dll" sevenzDll dll chattyDownload "7z.exe" sevenzExe exe return $ \outdir archive -> do let cmd = toFilePath exe args = [ "x" , "-o" ++ toFilePath outdir , "-y" , toFilePath archive ] $logProcessRun cmd args ec <- liftIO $ rawSystem cmd args when (ec /= ExitSuccess) $ liftIO $ throwM (ProblemWhileDecompressing archive) _ -> throwM SetupInfoMissingSevenz chattyDownload :: (MonadReader env m, HasHttpManager env, MonadIO m, MonadLogger m, MonadThrow m, MonadBaseControl IO m) => Text -- ^ label -> DownloadInfo -- ^ URL, content-length, and sha1 -> Path Abs File -- ^ destination -> m () chattyDownload label downloadInfo path = do let url = downloadInfoUrl downloadInfo req <- parseUrl $ T.unpack url $logSticky $ T.concat [ "Preparing to download " , label , " ..." ] $logDebug $ T.concat [ "Downloading from " , url , " to " , T.pack $ toFilePath path , " ..." ] hashChecks <- case downloadInfoSha1 downloadInfo of Just sha1ByteString -> do let sha1 = CheckHexDigestByteString sha1ByteString $logDebug $ T.concat [ "Will check against sha1 hash: " , T.decodeUtf8With T.lenientDecode sha1ByteString ] return [HashCheck SHA1 sha1] Nothing -> do $logWarn $ T.concat [ "No sha1 found in metadata," , " download hash won't be checked." ] return [] let dReq = DownloadRequest { drRequest = req , drHashChecks = hashChecks , drLengthCheck = mtotalSize , drRetryPolicy = drRetryPolicyDefault } runInBase <- liftBaseWith $ \run -> return (void . run) x <- verifiedDownload dReq path (chattyDownloadProgress runInBase) if x then $logStickyDone ("Downloaded " <> label <> ".") else $logStickyDone "Already downloaded." where mtotalSize = downloadInfoContentLength downloadInfo chattyDownloadProgress runInBase _ = do _ <- liftIO $ runInBase $ $logSticky $ label <> ": download has begun" CL.map (Sum . S.length) =$ chunksOverTime 1 =$ go where go = evalStateC 0 $ awaitForever $ \(Sum size) -> do modify (+ size) totalSoFar <- get liftIO $ runInBase $ $logSticky $ T.pack $ case mtotalSize of Nothing -> chattyProgressNoTotal totalSoFar Just 0 -> chattyProgressNoTotal totalSoFar Just totalSize -> chattyProgressWithTotal totalSoFar totalSize -- Example: ghc: 42.13 KiB downloaded... chattyProgressNoTotal totalSoFar = printf ("%s: " <> bytesfmt "%7.2f" totalSoFar <> " downloaded...") (T.unpack label) -- Example: ghc: 50.00 MiB / 100.00 MiB (50.00%) downloaded... chattyProgressWithTotal totalSoFar total = printf ("%s: " <> bytesfmt "%7.2f" totalSoFar <> " / " <> bytesfmt "%.2f" total <> " (%6.2f%%) downloaded...") (T.unpack label) percentage where percentage :: Double percentage = fromIntegral totalSoFar / fromIntegral total * 100 -- | Given a printf format string for the decimal part and a number of -- bytes, formats the bytes using an appropiate unit and returns the -- formatted string. -- -- >>> bytesfmt "%.2" 512368 -- "500.359375 KiB" bytesfmt :: Integral a => String -> a -> String bytesfmt formatter bs = printf (formatter <> " %s") (fromIntegral (signum bs) * dec :: Double) (bytesSuffixes !! i) where (dec,i) = getSuffix (abs bs) getSuffix n = until p (\(x,y) -> (x / 1024, y+1)) (fromIntegral n,0) where p (n',numDivs) = n' < 1024 || numDivs == (length bytesSuffixes - 1) bytesSuffixes :: [String] bytesSuffixes = ["B","KiB","MiB","GiB","TiB","PiB","EiB","ZiB","YiB"] -- Await eagerly (collect with monoidal append), -- but space out yields by at least the given amount of time. -- The final yield may come sooner, and may be a superfluous mempty. -- Note that Integer and Float literals can be turned into NominalDiffTime -- (these literals are interpreted as "seconds") chunksOverTime :: (Monoid a, MonadIO m) => NominalDiffTime -> Conduit a m a chunksOverTime diff = do currentTime <- liftIO getCurrentTime evalStateC (currentTime, mempty) go where -- State is a tuple of: -- * the last time a yield happened (or the beginning of the sink) -- * the accumulated awaits since the last yield go = await >>= \case Nothing -> do (_, acc) <- get yield acc Just a -> do (lastTime, acc) <- get let acc' = acc <> a currentTime <- liftIO getCurrentTime if diff < diffUTCTime currentTime lastTime then put (currentTime, mempty) >> yield acc' else put (lastTime, acc') go -- | Perform a basic sanity check of GHC sanityCheck :: (MonadIO m, MonadMask m, MonadLogger m, MonadBaseControl IO m) => EnvOverride -> WhichCompiler -> m () sanityCheck menv wc = withSystemTempDir "stack-sanity-check" $ \dir -> do let fp = toFilePath $ dir $(mkRelFile "Main.hs") liftIO $ writeFile fp $ unlines [ "import Distribution.Simple" -- ensure Cabal library is present , "main = putStrLn \"Hello World\"" ] let exeName = compilerExeName wc ghc <- join $ findExecutable menv exeName $logDebug $ "Performing a sanity check on: " <> T.pack (toFilePath ghc) eres <- tryProcessStdout (Just dir) menv exeName [ fp , "-no-user-package-db" ] case eres of Left e -> throwM $ GHCSanityCheckCompileFailed e ghc Right _ -> return () -- TODO check that the output of running the command is correct -- Remove potentially confusing environment variables removeHaskellEnvVars :: Map Text Text -> Map Text Text removeHaskellEnvVars = Map.delete "GHCJS_PACKAGE_PATH" . Map.delete "GHC_PACKAGE_PATH" . Map.delete "HASKELL_PACKAGE_SANDBOX" . Map.delete "HASKELL_PACKAGE_SANDBOXES" . Map.delete "HASKELL_DIST_DIR" . -- https://github.com/commercialhaskell/stack/issues/1460 Map.delete "DESTDIR" -- | Get map of environment variables to set to change the GHC's encoding to UTF-8 getUtf8EnvVars :: forall m env. (MonadReader env m, HasPlatform env, MonadLogger m, MonadCatch m, MonadBaseControl IO m, MonadIO m) => EnvOverride -> CompilerVersion -> m (Map Text Text) getUtf8EnvVars menv compilerVer = do if getGhcVersion compilerVer >= $(mkVersion "7.10.3") -- GHC_CHARENC supported by GHC >=7.10.3 then return $ Map.singleton "GHC_CHARENC" "UTF-8" else legacyLocale where legacyLocale = do Platform _ os <- asks getPlatform if os == Cabal.Windows then -- On Windows, locale is controlled by the code page, so we don't set any environment -- variables. return Map.empty else do let checkedVars = map checkVar (Map.toList $ eoTextMap menv) -- List of environment variables that will need to be updated to set UTF-8 (because -- they currently do not specify UTF-8). needChangeVars = concatMap fst checkedVars -- Set of locale-related environment variables that have already have a value. existingVarNames = Set.unions (map snd checkedVars) -- True if a locale is already specified by one of the "global" locale variables. hasAnyExisting = any (`Set.member` existingVarNames) ["LANG", "LANGUAGE", "LC_ALL"] if null needChangeVars && hasAnyExisting then -- If no variables need changes and at least one "global" variable is set, no -- changes to environment need to be made. return Map.empty else do -- Get a list of known locales by running @locale -a@. elocales <- tryProcessStdout Nothing menv "locale" ["-a"] let -- Filter the list to only include locales with UTF-8 encoding. utf8Locales = case elocales of Left _ -> [] Right locales -> filter isUtf8Locale (T.lines $ T.decodeUtf8With T.lenientDecode locales) mfallback = getFallbackLocale utf8Locales when (isNothing mfallback) ($logWarn "Warning: unable to set locale to UTF-8 encoding; GHC may fail with 'invalid character'") let -- Get the new values of variables to adjust. changes = Map.unions $ map (adjustedVarValue utf8Locales mfallback) needChangeVars -- Get the values of variables to add. adds | hasAnyExisting = -- If we already have a "global" variable, then nothing needs -- to be added. Map.empty | otherwise = -- If we don't already have a "global" variable, then set LANG to the -- fallback. case mfallback of Nothing -> Map.empty Just fallback -> Map.singleton "LANG" fallback return (Map.union changes adds) -- Determines whether an environment variable is locale-related and, if so, whether it needs to -- be adjusted. checkVar :: (Text, Text) -> ([Text], Set Text) checkVar (k,v) = if k `elem` ["LANG", "LANGUAGE"] || "LC_" `T.isPrefixOf` k then if isUtf8Locale v then ([], Set.singleton k) else ([k], Set.singleton k) else ([], Set.empty) -- Adjusted value of an existing locale variable. Looks for valid UTF-8 encodings with -- same language /and/ territory, then with same language, and finally the first UTF-8 locale -- returned by @locale -a@. adjustedVarValue :: [Text] -> Maybe Text -> Text -> Map Text Text adjustedVarValue utf8Locales mfallback k = case Map.lookup k (eoTextMap menv) of Nothing -> Map.empty Just v -> case concatMap (matchingLocales utf8Locales) [ T.takeWhile (/= '.') v <> "." , T.takeWhile (/= '_') v <> "_"] of (v':_) -> Map.singleton k v' [] -> case mfallback of Just fallback -> Map.singleton k fallback Nothing -> Map.empty -- Determine the fallback locale, by looking for any UTF-8 locale prefixed with the list in -- @fallbackPrefixes@, and if not found, picking the first UTF-8 encoding returned by @locale -- -a@. getFallbackLocale :: [Text] -> Maybe Text getFallbackLocale utf8Locales = case concatMap (matchingLocales utf8Locales) fallbackPrefixes of (v:_) -> Just v [] -> case utf8Locales of [] -> Nothing (v:_) -> Just v -- Filter the list of locales for any with the given prefixes (case-insitive). matchingLocales :: [Text] -> Text -> [Text] matchingLocales utf8Locales prefix = filter (\v -> T.toLower prefix `T.isPrefixOf` T.toLower v) utf8Locales -- Does the locale have one of the encodings in @utf8Suffixes@ (case-insensitive)? isUtf8Locale locale = any (\ v -> T.toLower v `T.isSuffixOf` T.toLower locale) utf8Suffixes -- Prefixes of fallback locales (case-insensitive) fallbackPrefixes = ["C.", "en_US.", "en_"] -- Suffixes of UTF-8 locales (case-insensitive) utf8Suffixes = [".UTF-8", ".utf8"] stack-1.1.2/src/Stack/Setup/Installed.hs0000644000000000000000000001547012717707441016236 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} module Stack.Setup.Installed ( getCompilerVersion , markInstalled , unmarkInstalled , listInstalled , Tool (..) , toolString , toolNameString , parseToolText , ExtraDirs (..) , extraDirs , installDir ) where import Control.Applicative import Control.Monad.Catch import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Logger import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Trans.Control import qualified Data.ByteString.Char8 as S8 import Data.List hiding (concat, elem, maximumBy) import Data.Maybe import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import Distribution.System (Platform (..)) import qualified Distribution.System as Cabal import GHC.Generics (Generic) import Generics.Deriving.Monoid (mappenddefault, memptydefault) import Path import Path.Extra (toFilePathNoTrailingSep) import Path.IO import Prelude hiding (concat, elem) -- Fix AMP warning import Stack.Types import System.Process.Read data Tool = Tool PackageIdentifier -- ^ e.g. ghc-7.8.4, msys2-20150512 | ToolGhcjs CompilerVersion -- ^ e.g. ghcjs-0.1.0_ghc-7.10.2 toolString :: Tool -> String toolString (Tool ident) = packageIdentifierString ident toolString (ToolGhcjs cv) = compilerVersionString cv toolNameString :: Tool -> String toolNameString (Tool ident) = packageNameString $ packageIdentifierName ident toolNameString ToolGhcjs{} = "ghcjs" parseToolText :: Text -> Maybe Tool parseToolText (parseCompilerVersion -> Just (cv@GhcjsVersion{})) = Just (ToolGhcjs cv) parseToolText (parsePackageIdentifierFromString . T.unpack -> Just pkgId) = Just (Tool pkgId) parseToolText _ = Nothing markInstalled :: (MonadIO m, MonadThrow m) => Path Abs Dir -> Tool -> m () markInstalled programsPath tool = do fpRel <- parseRelFile $ toolString tool ++ ".installed" liftIO $ writeFile (toFilePath $ programsPath fpRel) "installed" unmarkInstalled :: (MonadIO m, MonadCatch m) => Path Abs Dir -> Tool -> m () unmarkInstalled programsPath tool = do fpRel <- parseRelFile $ toolString tool ++ ".installed" ignoringAbsence (removeFile $ programsPath fpRel) listInstalled :: (MonadIO m, MonadThrow m) => Path Abs Dir -> m [Tool] listInstalled programsPath = do ensureDir programsPath (_, files) <- listDir programsPath return $ mapMaybe toTool files where toTool fp = do x <- T.stripSuffix ".installed" $ T.pack $ toFilePath $ filename fp parseToolText x getCompilerVersion :: (MonadLogger m, MonadCatch m, MonadBaseControl IO m, MonadIO m) => EnvOverride -> WhichCompiler -> m CompilerVersion getCompilerVersion menv wc = case wc of Ghc -> do $logDebug "Asking GHC for its version" bs <- readProcessStdout Nothing menv "ghc" ["--numeric-version"] let (_, ghcVersion) = versionFromEnd bs GhcVersion <$> parseVersion (T.decodeUtf8 ghcVersion) Ghcjs -> do $logDebug "Asking GHCJS for its version" -- Output looks like -- -- The Glorious Glasgow Haskell Compilation System for JavaScript, version 0.1.0 (GHC 7.10.2) bs <- readProcessStdout Nothing menv "ghcjs" ["--version"] let (rest, ghcVersion) = T.decodeUtf8 <$> versionFromEnd bs (_, ghcjsVersion) = T.decodeUtf8 <$> versionFromEnd rest GhcjsVersion <$> parseVersion ghcjsVersion <*> parseVersion ghcVersion where versionFromEnd = S8.spanEnd isValid . fst . S8.breakEnd isValid isValid c = c == '.' || ('0' <= c && c <= '9') -- | Binary directories for the given installed package extraDirs :: (MonadReader env m, HasConfig env, MonadThrow m, MonadLogger m) => Tool -> m ExtraDirs extraDirs tool = do config <- asks getConfig dir <- installDir (configLocalPrograms config) tool case (configPlatform config, toolNameString tool) of (Platform _ Cabal.Windows, isGHC -> True) -> return mempty { edBins = goList [ dir $(mkRelDir "bin") , dir $(mkRelDir "mingw") $(mkRelDir "bin") ] } (Platform Cabal.I386 Cabal.Windows, "msys2") -> return mempty { edBins = goList [ dir $(mkRelDir "mingw32") $(mkRelDir "bin") , dir $(mkRelDir "usr") $(mkRelDir "bin") , dir $(mkRelDir "usr") $(mkRelDir "local") $(mkRelDir "bin") ] , edInclude = goList [ dir $(mkRelDir "mingw32") $(mkRelDir "include") ] , edLib = goList [ dir $(mkRelDir "mingw32") $(mkRelDir "lib") ] } (Platform Cabal.X86_64 Cabal.Windows, "msys2") -> return mempty { edBins = goList [ dir $(mkRelDir "mingw64") $(mkRelDir "bin") , dir $(mkRelDir "usr") $(mkRelDir "bin") , dir $(mkRelDir "usr") $(mkRelDir "local") $(mkRelDir "bin") ] , edInclude = goList [ dir $(mkRelDir "mingw64") $(mkRelDir "include") ] , edLib = goList [ dir $(mkRelDir "mingw64") $(mkRelDir "lib") ] } (_, isGHC -> True) -> return mempty { edBins = goList [ dir $(mkRelDir "bin") ] } (_, isGHCJS -> True) -> return mempty { edBins = goList [ dir $(mkRelDir "bin") ] } (Platform _ x, toolName) -> do $logWarn $ "binDirs: unexpected OS/tool combo: " <> T.pack (show (x, toolName)) return mempty where goList = map toFilePathNoTrailingSep isGHC n = "ghc" == n || "ghc-" `isPrefixOf` n isGHCJS n = "ghcjs" == n data ExtraDirs = ExtraDirs { edBins :: ![FilePath] , edInclude :: ![FilePath] , edLib :: ![FilePath] } deriving (Show, Generic) instance Monoid ExtraDirs where mempty = memptydefault mappend = mappenddefault installDir :: (MonadReader env m, MonadThrow m) => Path Abs Dir -> Tool -> m (Path Abs Dir) installDir programsDir tool = do reldir <- parseRelDir $ toolString tool return $ programsDir reldir stack-1.1.2/src/Stack/Sig.hs0000644000000000000000000000047612706265473013743 0ustar0000000000000000{-| Module : Stack.Sig Description : GPG Signatures for Stack Copyright : (c) FPComplete.com, 2015 License : BSD3 Maintainer : Tim Dysinger Stability : experimental Portability : POSIX -} module Stack.Sig (module Sig) where import Stack.Sig.GPG as Sig import Stack.Sig.Sign as Sig stack-1.1.2/src/Stack/Sig/GPG.hs0000644000000000000000000000770012717707441014353 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TemplateHaskell #-} {-| Module : Stack.Sig.GPG Description : GPG Functions Copyright : (c) FPComplete.com, 2015 License : BSD3 Maintainer : Tim Dysinger Stability : experimental Portability : POSIX -} module Stack.Sig.GPG (gpgSign, gpgVerify) where import Prelude () import Prelude.Compat import Control.Monad (unless, when) import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Logger (MonadLogger, logWarn) import qualified Data.ByteString.Char8 as C import Data.List (find, isPrefixOf) import Data.Monoid ((<>)) import qualified Data.Text as T import Path import Stack.Types import System.Directory (findExecutable) import System.Environment (lookupEnv) import System.Exit (ExitCode(..)) import System.IO (Handle, hGetContents, hPutStrLn) import System.Info (os) import System.Process (ProcessHandle, runInteractiveProcess, waitForProcess) -- | Sign a file path with GPG, returning the @Signature@. gpgSign :: (MonadIO m, MonadLogger m, MonadThrow m) => Path Abs File -> m Signature gpgSign path = do gpgWarnTTY (_hIn,hOut,hErr,process) <- gpg [ "--output" , "-" , "--use-agent" , "--detach-sig" , "--armor" , toFilePath path] (out,err,code) <- liftIO ((,,) <$> hGetContents hOut <*> hGetContents hErr <*> waitForProcess process) if code /= ExitSuccess then throwM (GPGSignException $ out <> "\n" <> err) else return (Signature $ C.pack out) -- | Verify the @Signature@ of a file path returning the -- @Fingerprint@. gpgVerify :: (MonadIO m, MonadThrow m) => Signature -> Path Abs File -> m Fingerprint gpgVerify (Signature signature) path = do (hIn,hOut,hErr,process) <- gpg ["--verify", "--with-fingerprint", "-", toFilePath path] (_in,out,err,code) <- liftIO ((,,,) <$> hPutStrLn hIn (C.unpack signature) <*> hGetContents hOut <*> hGetContents hErr <*> waitForProcess process) if code /= ExitSuccess then throwM (GPGVerifyException (out ++ "\n" ++ err)) else maybe (throwM (GPGFingerprintException ("unable to extract fingerprint from output\n: " <> out))) return (mkFingerprint . T.pack . concat . drop 3 <$> find ((==) ["Primary", "key", "fingerprint:"] . take 3) (map words (lines err))) -- | Try to execute `gpg2` but fallback to `gpg` (as a backup) gpg :: (MonadIO m, MonadThrow m) => [String] -> m (Handle, Handle, Handle, ProcessHandle) gpg args = do mGpg2Path <- liftIO (findExecutable "gpg2") case mGpg2Path of Just _ -> liftIO (runInteractiveProcess "gpg2" args Nothing Nothing) Nothing -> do mGpgPath <- liftIO (findExecutable "gpg") case mGpgPath of Just _ -> liftIO (runInteractiveProcess "gpg" args Nothing Nothing) Nothing -> throwM GPGNotFoundException -- | `man gpg-agent` shows that you need GPG_TTY environment variable set to -- properly deal with interactions with gpg-agent. (Doesn't apply to Windows -- though) gpgWarnTTY :: (MonadIO m, MonadLogger m) => m () gpgWarnTTY = unless ("ming" `isPrefixOf` os) (do mTTY <- liftIO (lookupEnv "GPG_TTY") when (null mTTY) ($logWarn "Environment variable GPG_TTY is not set (see `man gpg-agent`)")) stack-1.1.2/src/Stack/Sig/Sign.hs0000644000000000000000000001144112717707441014633 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-| Module : Stack.Sig.Sign Description : Signing Packages Copyright : (c) FPComplete.com, 2015 License : BSD3 Maintainer : Tim Dysinger Stability : experimental Portability : POSIX -} module Stack.Sig.Sign (sign, signPackage, signTarBytes) where import Prelude () import Prelude.Compat import qualified Codec.Archive.Tar as Tar import qualified Codec.Compression.GZip as GZip import Control.Monad (when) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy as L import Data.Monoid ((<>)) import qualified Data.Text as T import Network.HTTP.Conduit (Response(..), RequestBody(..), Request(..), httpLbs) import Network.HTTP.Client (Manager) import Network.HTTP.Download import Network.HTTP.Types (status200, methodPut) import Path import Path.IO import Stack.Package import Stack.Sig.GPG import Stack.Types import qualified System.FilePath as FP -- | Sign a haskell package with the given url of the signature -- service and a path to a tarball. sign #if __GLASGOW_HASKELL__ < 710 :: (Applicative m, MonadIO m, MonadLogger m, MonadMask m) #else :: (MonadIO m, MonadLogger m, MonadMask m) #endif => Manager -> String -> Path Abs File -> m Signature sign manager url filePath = withSystemTempDir "stack" (\tempDir -> do bytes <- liftIO (fmap GZip.decompress (BS.readFile (toFilePath filePath))) maybePath <- extractCabalFile tempDir (Tar.read bytes) case maybePath of Nothing -> throwM SigInvalidSDistTarBall Just cabalPath -> do pkg <- cabalFilePackageId (tempDir cabalPath) signPackage manager url pkg filePath) where extractCabalFile tempDir (Tar.Next entry entries) = case Tar.entryContent entry of (Tar.NormalFile lbs _) -> case FP.splitFileName (Tar.entryPath entry) of (folder,file) | length (FP.splitDirectories folder) == 1 && FP.takeExtension file == ".cabal" -> do cabalFile <- parseRelFile file liftIO (BS.writeFile (toFilePath (tempDir cabalFile)) lbs) return (Just cabalFile) (_,_) -> extractCabalFile tempDir entries _ -> extractCabalFile tempDir entries extractCabalFile _ _ = return Nothing -- | Sign a haskell package with the given url to the signature -- service, a package tarball path (package tarball name) and a lazy -- bytestring of bytes that represent the tarball bytestream. The -- function will write the bytes to the path in a temp dir and sign -- the tarball with GPG. signTarBytes #if __GLASGOW_HASKELL__ < 710 :: (Applicative m, MonadIO m, MonadLogger m, MonadMask m) #else :: (MonadIO m, MonadLogger m, MonadMask m) #endif => Manager -> String -> Path Rel File -> L.ByteString -> m Signature signTarBytes manager url tarPath bs = withSystemTempDir "stack" (\tempDir -> do let tempTarBall = tempDir tarPath liftIO (L.writeFile (toFilePath tempTarBall) bs) sign manager url tempTarBall) -- | Sign a haskell package given the url to the signature service, a -- @PackageIdentifier@ and a file path to the package on disk. signPackage :: (MonadIO m, MonadLogger m, MonadThrow m) => Manager -> String -> PackageIdentifier -> Path Abs File -> m Signature signPackage manager url pkg filePath = do sig@(Signature signature) <- gpgSign filePath let (PackageIdentifier name version) = pkg fingerprint <- gpgVerify sig filePath let fullUrl = url <> "/upload/signature/" <> show name <> "/" <> show version <> "/" <> show fingerprint req <- parseUrl fullUrl let put = req { method = methodPut , requestBody = RequestBodyBS signature } res <- liftIO (httpLbs put manager) when (responseStatus res /= status200) (throwM (GPGSignException "unable to sign & upload package")) $logInfo ("Signature uploaded to " <> T.pack fullUrl) return sig stack-1.1.2/src/Stack/Solver.hs0000644000000000000000000010154112717707447014472 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module Stack.Solver ( checkResolverSpec , cabalPackagesCheck , findCabalFiles , getResolverConstraints , mergeConstraints , solveExtraDeps , solveResolverSpec -- * Internal - for tests , parseCabalOutputLine ) where import Prelude () import Prelude.Compat import Control.Applicative import Control.Exception (assert) import Control.Exception.Enclosed (tryIO) import Control.Monad (when,void,join,liftM,unless,zipWithM_) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (MonadReader, asks) import Control.Monad.Trans.Control import Data.Aeson.Extended ( WithJSONWarnings(..), object, (.=), toJSON , logJSONWarnings) import qualified Data.ByteString as S import Data.Char (isSpace) import Data.Either import Data.Function (on) import qualified Data.HashMap.Strict as HashMap import Data.List ( (\\), isSuffixOf, intercalate , minimumBy, isPrefixOf) import Data.List.Extra (groupSortOn) import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (catMaybes, isNothing, mapMaybe, fromMaybe) import Data.Monoid import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as LT import Data.Text.Lazy.Encoding (decodeUtf8With) import Data.Tuple (swap) import qualified Data.Yaml as Yaml import qualified Distribution.Package as C import qualified Distribution.PackageDescription as C import qualified Distribution.Text as C import Network.HTTP.Client.Conduit (HasHttpManager) import Text.Regex.Applicative.Text (match, sym, psym, anySym, few) import Path import Path.Find (findFiles) import Path.IO hiding (findExecutable, findFiles) import Stack.BuildPlan import Stack.Constants (stackDotYaml) import Stack.Package (printCabalFileWarning , hpack , readPackageUnresolved) import Stack.Setup import Stack.Setup.Installed import Stack.Types import Stack.Types.Internal ( HasTerminal , HasReExec , HasLogLevel) import qualified System.Directory as D import qualified System.FilePath as FP import System.Process.Read data ConstraintType = Constraint | Preference deriving (Eq) type ConstraintSpec = Map PackageName (Version, Map FlagName Bool) cabalSolver :: (MonadIO m, MonadLogger m, MonadMask m, MonadBaseControl IO m, MonadReader env m, HasConfig env) => EnvOverride -> [Path Abs Dir] -- ^ cabal files -> ConstraintType -> ConstraintSpec -- ^ src constraints -> ConstraintSpec -- ^ dep constraints -> [String] -- ^ additional arguments -> m (Either [PackageName] ConstraintSpec) cabalSolver menv cabalfps constraintType srcConstraints depConstraints cabalArgs = withSystemTempDir "cabal-solver" $ \dir' -> do let versionConstraints = fmap fst depConstraints dir = toFilePath dir' configLines <- getCabalConfig dir constraintType versionConstraints let configFile = dir FP. "cabal.config" liftIO $ S.writeFile configFile $ encodeUtf8 $ T.unlines configLines -- Run from a temporary directory to avoid cabal getting confused by any -- sandbox files, see: -- https://github.com/commercialhaskell/stack/issues/356 -- -- In theory we could use --ignore-sandbox, but not all versions of cabal -- support it. tmpdir <- getTempDir let args = ("--config-file=" ++ configFile) : "install" : "--enable-tests" : "--enable-benchmarks" : "--dry-run" : "--reorder-goals" : "--max-backjumps=-1" : "--package-db=clear" : "--package-db=global" : cabalArgs ++ toConstraintArgs (flagConstraints constraintType) ++ fmap toFilePath cabalfps catch (liftM Right (readProcessStdout (Just tmpdir) menv "cabal" args)) (\ex -> case ex of ReadProcessException _ _ _ err -> return $ Left err _ -> throwM ex) >>= either parseCabalErrors parseCabalOutput where errCheck = T.isInfixOf "Could not resolve dependencies" cabalBuildErrMsg e = ">>>> Cabal errors begin\n" <> e <> "<<<< Cabal errors end\n" parseCabalErrors err = do let errExit e = error $ "Could not parse cabal-install errors:\n\n" ++ cabalBuildErrMsg (T.unpack e) msg = LT.toStrict $ decodeUtf8With lenientDecode err if errCheck msg then do $logInfo "Attempt failed.\n" $logInfo $ cabalBuildErrMsg msg let pkgs = parseConflictingPkgs msg mPkgNames = map (C.simpleParse . T.unpack) pkgs pkgNames = map (fromCabalPackageName . C.pkgName) (catMaybes mPkgNames) when (any isNothing mPkgNames) $ do $logInfo $ "*** Only some package names could be parsed: " <> (T.pack (intercalate ", " (map show pkgNames))) error $ T.unpack $ "*** User packages involved in cabal failure: " <> (T.intercalate ", " $ parseConflictingPkgs msg) if pkgNames /= [] then do return $ Left pkgNames else errExit msg else errExit msg parseConflictingPkgs msg = let ls = dropWhile (not . errCheck) $ T.lines msg select s = ((T.isPrefixOf "trying:" s) || (T.isPrefixOf "next goal:" s)) && (T.isSuffixOf "(user goal)" s) pkgName = (take 1) . T.words . (T.drop 1) . (T.dropWhile (/= ':')) in concat $ map pkgName (filter select ls) parseCabalOutput bs = do let ls = drop 1 $ dropWhile (not . T.isPrefixOf "In order, ") $ map stripCR $ T.lines $ decodeUtf8 bs (errs, pairs) = partitionEithers $ map parseCabalOutputLine ls if null errs then return $ Right (Map.fromList pairs) else error $ "The following lines from cabal-install output could \ \not be parsed: \n" ++ (T.unpack (T.intercalate "\n" errs)) stripCR t = fromMaybe t (T.stripSuffix "\r" t) toConstraintArgs userFlagMap = [formatFlagConstraint package flag enabled | (package, fs) <- Map.toList userFlagMap , (flag, enabled) <- Map.toList fs] formatFlagConstraint package flag enabled = let sign = if enabled then '+' else '-' in "--constraint=" ++ unwords [packageNameString package, sign : flagNameString flag] -- Note the order of the Map union is important -- We override a package in snapshot by a src package flagConstraints Constraint = fmap snd (Map.union srcConstraints depConstraints) -- Even when using preferences we want to -- keep the src package flags unchanged -- TODO - this should be done only for manual flags. flagConstraints Preference = fmap snd srcConstraints -- An ugly parser to extract module id and flags parseCabalOutputLine :: Text -> Either Text (PackageName, (Version, Map FlagName Bool)) parseCabalOutputLine t0 = maybe (Left t0) Right . join . match re $ t0 -- Sample outputs to parse: -- text-1.2.1.1 (latest: 1.2.2.0) -integer-simple (via: parsec-3.1.9) (new package)) -- hspec-snap-1.0.0.0 *test (via: servant-snap-0.5) (new package) -- time-locale-compat-0.1.1.1 -old-locale (via: http-api-data-0.2.2) (new package)) -- flowdock-rest-0.2.0.0 -aeson-compat *test (via: haxl-fxtra-0.0.0.0) (new package) where re = mk <$> some (psym $ not . isSpace) <*> many (lexeme reMaybeFlag) reMaybeFlag = (\s -> Just (True, s)) <$ sym '+' <*> some (psym $ not . isSpace) <|> (\s -> Just (False, s)) <$ sym '-' <*> some (psym $ not . isSpace) <|> Nothing <$ sym '*' <* some (psym $ not . isSpace) <|> Nothing <$ sym '(' <* few anySym <* sym ')' mk :: String -> [Maybe (Bool, String)] -> Maybe (PackageName, (Version, Map FlagName Bool)) mk ident fl = do PackageIdentifier name version <- parsePackageIdentifierFromString ident fl' <- (traverse . traverse) parseFlagNameFromString $ catMaybes fl return (name, (version, Map.fromList $ map swap fl')) lexeme r = some (psym isSpace) *> r getCabalConfig :: (MonadLogger m, MonadReader env m, HasConfig env, MonadIO m, MonadThrow m) => FilePath -- ^ temp dir -> ConstraintType -> Map PackageName Version -- ^ constraints -> m [Text] getCabalConfig dir constraintType constraints = do indices <- asks $ configPackageIndices . getConfig remotes <- mapM goIndex indices let cache = T.pack $ "remote-repo-cache: " ++ dir return $ cache : remotes ++ map goConstraint (Map.toList constraints) where goIndex index = do src <- configPackageIndex $ indexName index let dstdir = dir FP. T.unpack (indexNameText $ indexName index) dst = dstdir FP. "00-index.tar" liftIO $ void $ tryIO $ do D.createDirectoryIfMissing True dstdir D.copyFile (toFilePath src) dst return $ T.concat [ "remote-repo: " , indexNameText $ indexName index , ":http://0.0.0.0/fake-url" ] goConstraint (name, version) = assert (not . null . versionString $ version) $ T.concat [ (if constraintType == Constraint then "constraint: " else "preference: ") , T.pack $ packageNameString name , "==" , T.pack $ versionString version ] setupCompiler :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m , MonadReader env m, HasConfig env , HasGHCVariant env , HasHttpManager env , HasLogLevel env , HasReExec env , HasTerminal env) => CompilerVersion -> m (Maybe ExtraDirs) setupCompiler compiler = do let msg = Just $ T.concat [ "Compiler version (" <> compilerVersionText compiler <> ") " , "required by your resolver specification cannot be found.\n\n" , "Please use '--install-ghc' command line switch to automatically " , "install the compiler or '--system-ghc' to use a suitable " , "compiler available on your PATH." ] config <- asks getConfig mpaths <- ensureCompiler SetupOpts { soptsInstallIfMissing = configInstallGHC config , soptsUseSystem = configSystemGHC config , soptsWantedCompiler = compiler , soptsCompilerCheck = configCompilerCheck config , soptsStackYaml = Nothing , soptsForceReinstall = False , soptsSanityCheck = False , soptsSkipGhcCheck = False , soptsSkipMsys = configSkipMsys config , soptsUpgradeCabal = False , soptsResolveMissingGHC = msg , soptsStackSetupYaml = defaultStackSetupYaml , soptsGHCBindistURL = Nothing } return mpaths setupCabalEnv :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m , MonadReader env m, HasConfig env , HasGHCVariant env , HasHttpManager env , HasLogLevel env , HasReExec env , HasTerminal env) => CompilerVersion -> m EnvOverride setupCabalEnv compiler = do mpaths <- setupCompiler compiler menv0 <- getMinimalEnvOverride envMap <- removeHaskellEnvVars <$> augmentPathMap (maybe [] edBins mpaths) (unEnvOverride menv0) platform <- asks getPlatform menv <- mkEnvOverride platform envMap mcabal <- findExecutable menv "cabal" case mcabal of Nothing -> throwM SolverMissingCabalInstall Just _ -> return () mver <- getSystemCompiler menv (whichCompiler compiler) case mver of Just (version, _) -> $logInfo $ "Using compiler: " <> compilerVersionText version Nothing -> error "Failed to determine compiler version. \ \This is most likely a bug." return menv -- | Merge two separate maps, one defining constraints on package versions and -- the other defining package flagmap, into a single map of version and flagmap -- tuples. mergeConstraints :: Map PackageName v -> Map PackageName (Map p f) -> Map PackageName (v, Map p f) mergeConstraints = Map.mergeWithKey -- combine entry in both maps (\_ v f -> Just (v, f)) -- convert entry in first map only (fmap (flip (,) Map.empty)) -- convert entry in second map only (\m -> if Map.null m then Map.empty else error "Bug: An entry in flag map must have a corresponding \ \entry in the version map") -- | Given a resolver, user package constraints (versions and flags) and extra -- dependency constraints determine what extra dependencies are required -- outside the resolver snapshot and the specified extra dependencies. -- -- First it tries by using the snapshot and the input extra dependencies -- as hard constraints, if no solution is arrived at by using hard -- constraints it then tries using them as soft constraints or preferences. -- -- It returns either conflicting packages when no solution is arrived at -- or the solution in terms of src package flag settings and extra -- dependencies. solveResolverSpec :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m , MonadReader env m, HasConfig env , HasGHCVariant env , HasHttpManager env , HasLogLevel env , HasReExec env , HasTerminal env) => Path Abs File -- ^ stack.yaml file location -> [Path Abs Dir] -- ^ package dirs containing cabal files -> ( Resolver , ConstraintSpec , ConstraintSpec) -- ^ ( resolver -- , src package constraints -- , extra dependency constraints ) -> m (Either [PackageName] (ConstraintSpec , ConstraintSpec)) -- ^ (Conflicting packages -- (resulting src package specs, external dependency specs)) solveResolverSpec stackYaml cabalDirs (resolver, srcConstraints, extraConstraints) = do $logInfo $ "Using resolver: " <> resolverName resolver (compilerVer, snapConstraints) <- getResolverConstraints stackYaml resolver menv <- setupCabalEnv compilerVer let -- Note - The order in Map.union below is important. -- We want to override snapshot with extra deps depConstraints = Map.union extraConstraints snapConstraints -- Make sure to remove any user packages from the dep constraints -- There are two reasons for this: -- 1. We do not want snapshot versions to override the sources -- 2. Sources may have blank versions leading to bad cabal constraints depOnlyConstraints = Map.difference depConstraints srcConstraints solver t = cabalSolver menv cabalDirs t srcConstraints depOnlyConstraints $ ["-v"] -- TODO make it conditional on debug ++ ["--ghcjs" | (whichCompiler compilerVer) == Ghcjs] let srcNames = (T.intercalate " and ") $ ["packages from " <> resolverName resolver | not (Map.null snapConstraints)] ++ [T.pack ((show $ Map.size extraConstraints) <> " external packages") | not (Map.null extraConstraints)] $logInfo "Asking cabal to calculate a build plan..." unless (Map.null depOnlyConstraints) ($logInfo $ "Trying with " <> srcNames <> " as hard constraints...") eresult <- solver Constraint eresult' <- case eresult of Left _ | not (Map.null depOnlyConstraints) -> do $logInfo $ "Retrying with " <> srcNames <> " as preferences..." solver Preference _ -> return eresult case eresult' of Right deps -> do let -- All src package constraints returned by cabal. -- Flags may have changed. srcs = Map.intersection deps srcConstraints inSnap = Map.intersection deps snapConstraints -- All packages which are in the snapshot but cabal solver -- returned versions or flags different from the snapshot. inSnapChanged = Map.differenceWith diffConstraints inSnap snapConstraints -- Packages neither in snapshot, nor srcs extra = Map.difference deps (Map.union srcConstraints snapConstraints) external = Map.union inSnapChanged extra -- Just in case. -- If cabal output contains versions of user packages, those -- versions better be the same as those in our cabal file i.e. -- cabal should not be solving using versions from external -- indices. let outVers = fmap fst srcs inVers = fmap fst srcConstraints bothVers = Map.intersectionWith (\v1 v2 -> (v1, v2)) inVers outVers when (not $ outVers `Map.isSubmapOf` inVers) $ do let msg = "Error: user package versions returned by cabal \ \solver are not the same as the versions in the \ \cabal files:\n" -- TODO We can do better in formatting the message error $ T.unpack $ msg <> (showItems $ map show (Map.toList bothVers)) $logInfo $ "Successfully determined a build plan with " <> T.pack (show $ Map.size external) <> " external dependencies." return $ Right (srcs, external) Left x -> do $logInfo $ "*** Failed to arrive at a workable build plan." return $ Left x where -- Think of the first map as the deps reported in cabal output and -- the second as the snapshot packages -- Note: For flags we only require that the flags in cabal output be a -- subset of the snapshot flags. This is to avoid a false difference -- reporting due to any spurious flags in the build plan which will -- always be absent in the cabal output. diffConstraints :: (Eq v, Eq a, Ord k) => (v, Map k a) -> (v, Map k a) -> Maybe (v, Map k a) diffConstraints (v, f) (v', f') | (v == v') && (f `Map.isSubmapOf` f') = Nothing | otherwise = Just (v, f) -- | Given a resolver (snpashot, compiler or custom resolver) -- return the compiler version, package versions and packages flags -- for that resolver. getResolverConstraints :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m , MonadReader env m, HasConfig env , HasGHCVariant env , HasHttpManager env) => Path Abs File -> Resolver -> m (CompilerVersion, Map PackageName (Version, Map FlagName Bool)) getResolverConstraints stackYaml resolver = do (mbp, _loadedResolver) <- loadResolver (Just stackYaml) resolver return (mbpCompilerVersion mbp, mbpConstraints mbp) where mpiConstraints mpi = (mpiVersion mpi, mpiFlags mpi) mbpConstraints mbp = fmap mpiConstraints (mbpPackages mbp) -- | Given a bundle of user packages, flag constraints on those packages and a -- resolver, determine if the resolver fully, partially or fails to satisfy the -- dependencies of the user packages. -- -- If the package flags are passed as 'Nothing' then flags are chosen -- automatically. checkResolverSpec :: ( MonadIO m, MonadMask m, MonadLogger m, MonadReader env m , HasHttpManager env, HasConfig env, HasGHCVariant env , MonadBaseControl IO m) => [C.GenericPackageDescription] -> Maybe (Map PackageName (Map FlagName Bool)) -> Resolver -> m BuildPlanCheck checkResolverSpec gpds flags resolver = do case resolver of ResolverSnapshot name -> checkSnapBuildPlan gpds flags name ResolverCompiler {} -> return $ BuildPlanCheckPartial Map.empty Map.empty -- TODO support custom resolver for stack init ResolverCustom {} -> return $ BuildPlanCheckPartial Map.empty Map.empty -- | Finds all files with a .cabal extension under a given directory. If -- a `hpack` `package.yaml` file exists, this will be used to generate a cabal -- file. -- Subdirectories can be included depending on the @recurse@ parameter. findCabalFiles :: (MonadIO m, MonadLogger m) => Bool -> Path Abs Dir -> m [Path Abs File] findCabalFiles recurse dir = do liftIO (findFiles dir isHpack subdirFilter) >>= mapM_ (hpack . parent) liftIO (findFiles dir isCabal subdirFilter) where subdirFilter subdir = recurse && not (isIgnored subdir) isHpack = (== "package.yaml") . toFilePath . filename isCabal = (".cabal" `isSuffixOf`) . toFilePath isIgnored path = "." `isPrefixOf` dirName || dirName `Set.member` ignoredDirs where dirName = FP.dropTrailingPathSeparator (toFilePath (dirname path)) -- | Special directories that we don't want to traverse for .cabal files ignoredDirs :: Set FilePath ignoredDirs = Set.fromList [ "dist" ] -- | Perform some basic checks on a list of cabal files to be used for creating -- stack config. It checks for duplicate package names, package name and -- cabal file name mismatch and reports any issues related to those. -- -- If no error occurs it returns filepath and @GenericPackageDescription@s -- pairs as well as any filenames for duplicate packages not included in the -- pairs. cabalPackagesCheck :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m , MonadReader env m, HasConfig env , HasGHCVariant env , HasHttpManager env , HasLogLevel env , HasReExec env , HasTerminal env) => [Path Abs File] -> String -> Maybe String -> m ( Map PackageName (Path Abs File, C.GenericPackageDescription) , [Path Abs File]) cabalPackagesCheck cabalfps noPkgMsg dupErrMsg = do when (null cabalfps) $ error noPkgMsg relpaths <- mapM prettyPath cabalfps $logInfo $ "Using cabal packages:" $logInfo $ T.pack (formatGroup relpaths) (warnings, gpds) <- fmap unzip (mapM readPackageUnresolved cabalfps) zipWithM_ (mapM_ . printCabalFileWarning) cabalfps warnings -- package name cannot be empty or missing otherwise -- it will result in cabal solver failure. -- stack requires packages name to match the cabal file name -- Just the latter check is enough to cover both the cases let packages = zip cabalfps gpds getNameMismatchPkg (fp, gpd) | (show . gpdPackageName) gpd /= (FP.takeBaseName . toFilePath) fp = Just fp | otherwise = Nothing nameMismatchPkgs = mapMaybe getNameMismatchPkg packages when (nameMismatchPkgs /= []) $ do rels <- mapM prettyPath nameMismatchPkgs error $ "Package name as defined in the .cabal file must match the \ \.cabal file name.\n\ \Please fix the following packages and try again:\n" <> (formatGroup rels) let dupGroups = filter ((> 1) . length) . groupSortOn (gpdPackageName . snd) dupAll = concat $ dupGroups packages -- Among duplicates prefer to include the ones in upper level dirs pathlen = length . FP.splitPath . toFilePath . fst getmin = minimumBy (compare `on` pathlen) dupSelected = map getmin (dupGroups packages) dupIgnored = dupAll \\ dupSelected unique = packages \\ dupIgnored when (dupIgnored /= []) $ do dups <- mapM (mapM (prettyPath. fst)) (dupGroups packages) $logWarn $ T.pack $ "Following packages have duplicate package names:\n" <> intercalate "\n" (map formatGroup dups) case dupErrMsg of Nothing -> $logWarn $ T.pack $ "Packages with duplicate names will be ignored.\n" <> "Packages in upper level directories will be preferred.\n" Just msg -> error msg return (Map.fromList $ map (\(file, gpd) -> (gpdPackageName gpd,(file, gpd))) unique , map fst dupIgnored) formatGroup :: [String] -> String formatGroup = concatMap (\path -> "- " <> path <> "\n") reportMissingCabalFiles :: (MonadIO m, MonadThrow m, MonadLogger m) => [Path Abs File] -- ^ Directories to scan -> Bool -- ^ Whether to scan sub-directories -> m () reportMissingCabalFiles cabalfps includeSubdirs = do allCabalfps <- findCabalFiles includeSubdirs =<< getCurrentDir relpaths <- mapM prettyPath (allCabalfps \\ cabalfps) unless (null relpaths) $ do $logWarn $ "The following packages are missing from the config:" $logWarn $ T.pack (formatGroup relpaths) -- TODO Currently solver uses a stack.yaml in the parent chain when there is -- no stack.yaml in the current directory. It should instead look for a -- stack yaml only in the current directory and suggest init if there is -- none available. That will make the behavior consistent with init and provide -- a correct meaning to a --ignore-subdirs option if implemented. -- | Verify the combination of resolver, package flags and extra -- dependencies in an existing stack.yaml and suggest changes in flags or -- extra dependencies so that the specified packages can be compiled. solveExtraDeps :: ( MonadBaseControl IO m, MonadIO m, MonadLogger m, MonadMask m , MonadReader env m, HasEnvConfig env, HasHttpManager env , HasLogLevel env, HasReExec env, HasTerminal env) => Bool -- ^ modify stack.yaml? -> m () solveExtraDeps modStackYaml = do econfig <- asks getEnvConfig bconfig <- asks getBuildConfig let stackYaml = bcStackYaml bconfig relStackYaml <- toFilePath <$> makeRelativeToCurrentDir stackYaml $logInfo $ "Using configuration file: " <> T.pack relStackYaml let cabalDirs = Map.keys $ envConfigPackages econfig noPkgMsg = "No cabal packages found in " <> relStackYaml <> ". Please add at least one directory containing a .cabal \ \file. You can also use 'stack init' to automatically \ \generate the config file." dupPkgFooter = "Please remove the directories containing duplicate \ \entries from '" <> relStackYaml <> "'." cabalfps <- liftM concat (mapM (findCabalFiles False) cabalDirs) -- TODO when solver supports --ignore-subdirs option pass that as the -- second argument here. reportMissingCabalFiles cabalfps True (bundle, _) <- cabalPackagesCheck cabalfps noPkgMsg (Just dupPkgFooter) let gpds = Map.elems $ fmap snd bundle oldFlags = unPackageFlags (bcFlags bconfig) oldExtraVersions = bcExtraDeps bconfig resolver = bcResolver bconfig oldSrcs = gpdPackages gpds oldSrcFlags = Map.intersection oldFlags oldSrcs oldExtraFlags = Map.intersection oldFlags oldExtraVersions srcConstraints = mergeConstraints oldSrcs oldSrcFlags extraConstraints = mergeConstraints oldExtraVersions oldExtraFlags let resolver' = toResolverNotLoaded resolver resolverResult <- checkResolverSpec gpds (Just oldSrcFlags) resolver' resultSpecs <- case resolverResult of BuildPlanCheckOk flags -> return $ Just ((mergeConstraints oldSrcs flags), Map.empty) BuildPlanCheckPartial {} -> do eres <- solveResolverSpec stackYaml cabalDirs (resolver', srcConstraints, extraConstraints) -- TODO Solver should also use the init code to ignore incompatible -- packages return $ either (const Nothing) Just eres BuildPlanCheckFail {} -> throwM $ ResolverMismatch IsSolverCmd resolver (show resolverResult) (srcs, edeps) <- case resultSpecs of Nothing -> throwM (SolverGiveUp giveUpMsg) Just x -> return x let flags = removeSrcPkgDefaultFlags gpds (fmap snd (Map.union srcs edeps)) versions = fmap fst edeps vDiff v v' = if v == v' then Nothing else Just v versionsDiff = Map.differenceWith vDiff newVersions = versionsDiff versions oldExtraVersions goneVersions = versionsDiff oldExtraVersions versions fDiff f f' = if f == f' then Nothing else Just f flagsDiff = Map.differenceWith fDiff newFlags = flagsDiff flags oldFlags goneFlags = flagsDiff oldFlags flags changed = any (not . Map.null) [newVersions, goneVersions] || any (not . Map.null) [newFlags, goneFlags] if changed then do $logInfo "" $logInfo $ "The following changes will be made to " <> T.pack relStackYaml <> ":" -- TODO print whether resolver changed from previous $logInfo $ "* Resolver is " <> resolverName resolver printFlags newFlags "* Flags to be added" printDeps newVersions "* Dependencies to be added" printFlags goneFlags "* Flags to be deleted" printDeps goneVersions "* Dependencies to be deleted" -- TODO backup the old config file if modStackYaml then do writeStackYaml stackYaml resolver versions flags $logInfo $ "Updated " <> T.pack relStackYaml else do $logInfo $ "To automatically update " <> T.pack relStackYaml <> ", rerun with '--update-config'" else $logInfo $ "No changes needed to " <> T.pack relStackYaml where indent t = T.unlines $ fmap (" " <>) (T.lines t) printFlags fl msg = do when ((not . Map.null) fl) $ do $logInfo $ T.pack msg $logInfo $ indent $ decodeUtf8 $ Yaml.encode $ object ["flags" .= fl] printDeps deps msg = do when ((not . Map.null) deps) $ do $logInfo $ T.pack msg $logInfo $ indent $ decodeUtf8 $ Yaml.encode $ object $ [("extra-deps" .= map fromTuple (Map.toList deps))] writeStackYaml path res deps fl = do let fp = toFilePath path obj <- liftIO (Yaml.decodeFileEither fp) >>= either throwM return WithJSONWarnings (ProjectAndConfigMonoid _ _) warnings <- liftIO (Yaml.decodeFileEither fp) >>= either throwM return logJSONWarnings fp warnings let obj' = HashMap.insert "extra-deps" (toJSON $ map fromTuple $ Map.toList deps) $ HashMap.insert ("flags" :: Text) (toJSON fl) $ HashMap.insert ("resolver" :: Text) (toJSON (resolverName res)) obj liftIO $ Yaml.encodeFile fp obj' giveUpMsg = concat [ " - Update external packages with 'stack update' and try again.\n" , " - Tweak " <> toFilePath stackDotYaml <> " and try again\n" , " - Remove any unnecessary packages.\n" , " - Add any missing remote packages.\n" , " - Add extra dependencies to guide solver.\n" ] prettyPath :: forall r t m. (MonadIO m, RelPath (Path r t) ~ Path Rel t, AnyPath (Path r t)) => Path r t -> m String prettyPath path = do eres <- liftIO $ try $ makeRelativeToCurrentDir path return $ case eres of Left (_ :: PathParseException) -> toFilePath path Right res -> toFilePath (res :: Path Rel t) stack-1.1.2/src/Stack/Types.hs0000644000000000000000000000110112707670645014311 0ustar0000000000000000-- | All types. module Stack.Types (module X) where import Stack.Types.BuildPlan as X import Stack.Types.FlagName as X import Stack.Types.GhcPkgId as X import Stack.Types.PackageIdentifier as X import Stack.Types.PackageIndex as X import Stack.Types.PackageName as X import Stack.Types.Version as X import Stack.Types.Config as X import Stack.Types.Docker as X import Stack.Types.Nix as X import Stack.Types.Image as X import Stack.Types.Build as X import Stack.Types.Urls as X import Stack.Types.Package as X import Stack.Types.Compiler as X import Stack.Types.Sig as X stack-1.1.2/src/Stack/Types/Build.hs0000644000000000000000000007076012717707441015365 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} -- | Build-specific types. module Stack.Types.Build (StackBuildException(..) ,FlagSource(..) ,UnusedFlags(..) ,InstallLocation(..) ,ModTime ,modTime ,Installed(..) ,PackageInstallInfo(..) ,Task(..) ,taskLocation ,LocalPackage(..) ,BaseConfigOpts(..) ,Plan(..) ,TestOpts(..) ,BenchmarkOpts(..) ,FileWatchOpts(..) ,BuildOpts(..) ,BuildSubset(..) ,defaultBuildOpts ,TaskType(..) ,TaskConfigOpts(..) ,ConfigCache(..) ,ConstructPlanException(..) ,configureOpts ,isStackOpt ,BadDependency(..) ,wantedLocalPackages ,FileCacheInfo (..) ,ConfigureOpts (..) ,PrecompiledCache (..)) where import Control.DeepSeq import Control.Exception import Data.Binary (getWord8, putWord8, gput, gget) import Data.Binary.VersionTagged import qualified Data.ByteString as S import Data.Char (isSpace) import Data.Data import Data.Hashable import Data.List (dropWhileEnd, nub, intercalate) import qualified Data.Map as Map import Data.Map.Strict (Map) import Data.Maybe import Data.Monoid import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Data.Time.Calendar import Data.Time.Clock import Distribution.System (Arch) import Distribution.PackageDescription (TestSuiteInterface) import Distribution.Text (display) import GHC.Generics (Generic, from, to) import Path (Path, Abs, File, Dir, mkRelDir, toFilePath, parseRelDir, ()) import Path.Extra (toFilePathNoTrailingSep) import Prelude import Stack.Types.BuildPlan (GitSHA1) import Stack.Types.Compiler import Stack.Types.Config import Stack.Types.FlagName import Stack.Types.GhcPkgId import Stack.Types.Package import Stack.Types.PackageIdentifier import Stack.Types.PackageName import Stack.Types.Version import System.Exit (ExitCode (ExitFailure)) import System.FilePath (pathSeparator) import System.Process.Log (showProcessArgDebug) ---------------------------------------------- -- Exceptions data StackBuildException = Couldn'tFindPkgId PackageName | CompilerVersionMismatch (Maybe (CompilerVersion, Arch)) (CompilerVersion, Arch) GHCVariant VersionCheck (Maybe (Path Abs File)) Text -- recommended resolution -- ^ Path to the stack.yaml file | Couldn'tParseTargets [Text] | UnknownTargets (Set PackageName) -- no known version (Map PackageName Version) -- not in snapshot, here's the most recent version in the index (Path Abs File) -- stack.yaml | TestSuiteFailure PackageIdentifier (Map Text (Maybe ExitCode)) (Maybe (Path Abs File)) S.ByteString | TestSuiteTypeUnsupported TestSuiteInterface | ConstructPlanExceptions [ConstructPlanException] (Path Abs File) -- stack.yaml | CabalExitedUnsuccessfully ExitCode PackageIdentifier (Path Abs File) -- cabal Executable [String] -- cabal arguments (Maybe (Path Abs File)) -- logfiles location [Text] -- log contents | ExecutionFailure [SomeException] | LocalPackageDoesn'tMatchTarget PackageName Version -- local version Version -- version specified on command line | NoSetupHsFound (Path Abs Dir) | InvalidFlagSpecification (Set UnusedFlags) | TargetParseException [Text] | DuplicateLocalPackageNames [(PackageName, [Path Abs Dir])] | SolverGiveUp String | SolverMissingCabalInstall | SomeTargetsNotBuildable [(PackageName, NamedComponent)] | TestSuiteExeMissing Bool String String String | CabalCopyFailed Bool String deriving Typeable data FlagSource = FSCommandLine | FSStackYaml deriving (Show, Eq, Ord) data UnusedFlags = UFNoPackage FlagSource PackageName | UFFlagsNotDefined FlagSource Package (Set FlagName) | UFSnapshot PackageName deriving (Show, Eq, Ord) instance Show StackBuildException where show (Couldn'tFindPkgId name) = ("After installing " <> packageNameString name <> ", the package id couldn't be found " <> "(via ghc-pkg describe " <> packageNameString name <> "). This shouldn't happen, " <> "please report as a bug") show (CompilerVersionMismatch mactual (expected, earch) ghcVariant check mstack resolution) = concat [ case mactual of Nothing -> "No compiler found, expected " Just (actual, arch) -> concat [ "Compiler version mismatched, found " , compilerVersionString actual , " (" , display arch , ")" , ", but expected " ] , case check of MatchMinor -> "minor version match with " MatchExact -> "exact version " NewerMinor -> "minor version match or newer with " , compilerVersionString expected , " (" , display earch , ghcVariantSuffix ghcVariant , ") (based on " , case mstack of Nothing -> "command line arguments" Just stack -> "resolver setting in " ++ toFilePath stack , ").\n" , T.unpack resolution ] show (Couldn'tParseTargets targets) = unlines $ "The following targets could not be parsed as package names or directories:" : map T.unpack targets show (UnknownTargets noKnown notInSnapshot stackYaml) = unlines $ noKnown' ++ notInSnapshot' where noKnown' | Set.null noKnown = [] | otherwise = return $ "The following target packages were not found: " ++ intercalate ", " (map packageNameString $ Set.toList noKnown) notInSnapshot' | Map.null notInSnapshot = [] | otherwise = "The following packages are not in your snapshot, but exist" : "in your package index. Recommended action: add them to your" : ("extra-deps in " ++ toFilePath stackYaml) : "(Note: these are the most recent versions," : "but there's no guarantee that they'll build together)." : "" : map (\(name, version) -> "- " ++ packageIdentifierString (PackageIdentifier name version)) (Map.toList notInSnapshot) show (TestSuiteFailure ident codes mlogFile bs) = unlines $ concat [ ["Test suite failure for package " ++ packageIdentifierString ident] , flip map (Map.toList codes) $ \(name, mcode) -> concat [ " " , T.unpack name , ": " , case mcode of Nothing -> " executable not found" Just ec -> " exited with: " ++ show ec ] , return $ case mlogFile of Nothing -> "Logs printed to console" -- TODO Should we load up the full error output and print it here? Just logFile -> "Full log available at " ++ toFilePath logFile , if S.null bs then [] else ["", "", doubleIndent $ T.unpack $ decodeUtf8With lenientDecode bs] ] where indent = dropWhileEnd isSpace . unlines . fmap (\line -> " " ++ line) . lines doubleIndent = indent . indent show (TestSuiteTypeUnsupported interface) = ("Unsupported test suite type: " <> show interface) show (ConstructPlanExceptions exceptions stackYaml) = "While constructing the BuildPlan the following exceptions were encountered:" ++ appendExceptions exceptions' ++ if Map.null extras then "" else (unlines $ ("\n\nRecommended action: try adding the following to your extra-deps in " ++ toFilePath stackYaml) : map (\(name, version) -> concat [ "- " , packageNameString name , "-" , versionString version ]) (Map.toList extras) ++ ["", "You may also want to try the 'stack solver' command"] ) where exceptions' = removeDuplicates exceptions appendExceptions = foldr (\e -> (++) ("\n\n--" ++ show e)) "" removeDuplicates = nub extras = Map.unions $ map getExtras exceptions' getExtras (DependencyCycleDetected _) = Map.empty getExtras (UnknownPackage _) = Map.empty getExtras (DependencyPlanFailures _ m) = Map.unions $ map go $ Map.toList m where go (name, (_range, Just version, NotInBuildPlan)) = Map.singleton name version go _ = Map.empty -- Supressing duplicate output show (CabalExitedUnsuccessfully exitCode taskProvides' execName fullArgs logFiles bss) = let fullCmd = unwords $ dropQuotes (toFilePath execName) : map (T.unpack . showProcessArgDebug) fullArgs logLocations = maybe "" (\fp -> "\n Logs have been written to: " ++ toFilePath fp) logFiles in "\n-- While building package " ++ dropQuotes (show taskProvides') ++ " using:\n" ++ " " ++ fullCmd ++ "\n" ++ " Process exited with code: " ++ show exitCode ++ (if exitCode == ExitFailure (-9) then " (THIS MAY INDICATE OUT OF MEMORY)" else "") ++ logLocations ++ (if null bss then "" else "\n\n" ++ doubleIndent (map T.unpack bss)) where doubleIndent = dropWhileEnd isSpace . unlines . fmap (\line -> " " ++ line) dropQuotes = filter ('\"' /=) show (ExecutionFailure es) = intercalate "\n\n" $ map show es show (LocalPackageDoesn'tMatchTarget name localV requestedV) = concat [ "Version for local package " , packageNameString name , " is " , versionString localV , ", but you asked for " , versionString requestedV , " on the command line" ] show (NoSetupHsFound dir) = "No Setup.hs or Setup.lhs file found in " ++ toFilePath dir show (InvalidFlagSpecification unused) = unlines $ "Invalid flag specification:" : map go (Set.toList unused) where showFlagSrc :: FlagSource -> String showFlagSrc FSCommandLine = " (specified on command line)" showFlagSrc FSStackYaml = " (specified in stack.yaml)" go :: UnusedFlags -> String go (UFNoPackage src name) = concat [ "- Package '" , packageNameString name , "' not found" , showFlagSrc src ] go (UFFlagsNotDefined src pkg flags) = concat [ "- Package '" , name , "' does not define the following flags" , showFlagSrc src , ":\n" , intercalate "\n" (map (\flag -> " " ++ flagNameString flag) (Set.toList flags)) , "\n- Flags defined by package '" ++ name ++ "':\n" , intercalate "\n" (map (\flag -> " " ++ name ++ ":" ++ flagNameString flag) (Set.toList pkgFlags)) ] where name = packageNameString (packageName pkg) pkgFlags = packageDefinedFlags pkg go (UFSnapshot name) = concat [ "- Attempted to set flag on snapshot package " , packageNameString name , ", please add to extra-deps" ] show (TargetParseException [err]) = "Error parsing targets: " ++ T.unpack err show (TargetParseException errs) = unlines $ "The following errors occurred while parsing the build targets:" : map (("- " ++) . T.unpack) errs show (DuplicateLocalPackageNames pairs) = concat $ "The same package name is used in multiple local packages\n" : map go pairs where go (name, dirs) = unlines $ "" : (packageNameString name ++ " used in:") : map goDir dirs goDir dir = "- " ++ toFilePath dir show (SolverGiveUp msg) = concat [ "\nSolver could not resolve package dependencies.\n" , "You can try the following:\n" , msg ] show SolverMissingCabalInstall = unlines [ "Solver requires that cabal be on your PATH" , "Try running 'stack install cabal-install'" ] show (SomeTargetsNotBuildable xs) = "The following components have 'buildable: False' set in the cabal configuration, and so cannot be targets:\n " ++ T.unpack (renderPkgComponents xs) ++ "\nTo resolve this, either provide flags such that these components are buildable, or only specify buildable targets." show (TestSuiteExeMissing isSimpleBuildType exeName pkgName testName) = missingExeError isSimpleBuildType $ concat [ "Test suite executable \"" , exeName , " not found for " , pkgName , ":test:" , testName ] show (CabalCopyFailed isSimpleBuildType innerMsg) = missingExeError isSimpleBuildType $ concat [ "'cabal copy' failed. Error message:\n" , innerMsg , "\n" ] missingExeError :: Bool -> String -> String missingExeError isSimpleBuildType msg = unlines $ msg : case possibleCauses of [] -> [] [cause] -> ["One possible cause of this issue is:\n* " <> cause] _ -> "Possible causes of this issue:" : map ("* " <>) possibleCauses where possibleCauses = "No module named \"Main\". The 'main-is' source file should usually have a header indicating that it's a 'Main' module." : if isSimpleBuildType then [] else ["The Setup.hs file is changing the installation target dir."] instance Exception StackBuildException data ConstructPlanException = DependencyCycleDetected [PackageName] | DependencyPlanFailures Package (Map PackageName (VersionRange, LatestApplicableVersion, BadDependency)) | UnknownPackage PackageName -- TODO perhaps this constructor will be removed, and BadDependency will handle it all -- ^ Recommend adding to extra-deps, give a helpful version number? deriving (Typeable, Eq) -- | For display purposes only, Nothing if package not found type LatestApplicableVersion = Maybe Version -- | Reason why a dependency was not used data BadDependency = NotInBuildPlan | Couldn'tResolveItsDependencies | DependencyMismatch Version deriving (Typeable, Eq) instance Show ConstructPlanException where show e = let details = case e of (DependencyCycleDetected pNames) -> "While checking call stack,\n" ++ " dependency cycle detected in packages:" ++ indent (appendLines pNames) (DependencyPlanFailures pkg (Map.toList -> pDeps)) -> "Failure when adding dependencies:" ++ doubleIndent (appendDeps pDeps) ++ "\n" ++ " needed for package " ++ packageIdentifierString (packageIdentifier pkg) ++ appendFlags (packageFlags pkg) (UnknownPackage pName) -> "While attempting to add dependency,\n" ++ " Could not find package " ++ show pName ++ " in known packages" in indent details where appendLines = foldr (\pName-> (++) ("\n" ++ show pName)) "" indent = dropWhileEnd isSpace . unlines . fmap (\line -> " " ++ line) . lines doubleIndent = indent . indent appendFlags flags = if Map.null flags then "" else " with flags:\n" ++ (doubleIndent . intercalate "\n" . map showFlag . Map.toList) flags showFlag (name, bool) = show name ++ ": " ++ show bool appendDeps = foldr (\dep-> (++) ("\n" ++ showDep dep)) "" showDep (name, (range, mlatestApplicable, badDep)) = concat [ show name , ": needed (" , display range , ")" , ", " , let latestApplicableStr = case mlatestApplicable of Nothing -> "" Just la -> " (latest applicable is " ++ versionString la ++ ")" in case badDep of NotInBuildPlan -> "stack configuration has no specified version" ++ latestApplicableStr Couldn'tResolveItsDependencies -> "couldn't resolve its dependencies" DependencyMismatch version -> case mlatestApplicable of Just la | la == version -> versionString version ++ " found (latest applicable version available)" _ -> versionString version ++ " found" ++ latestApplicableStr ] {- TODO Perhaps change the showDep function to look more like this: dropQuotes = filter ((/=) '\"') (VersionOutsideRange pName pIdentifier versionRange) -> "Exception: Stack.Build.VersionOutsideRange\n" ++ " While adding dependency for package " ++ show pName ++ ",\n" ++ " " ++ dropQuotes (show pIdentifier) ++ " was found to be outside its allowed version range.\n" ++ " Allowed version range is " ++ display versionRange ++ ",\n" ++ " should you correct the version range for " ++ dropQuotes (show pIdentifier) ++ ", found in [extra-deps] in the project's stack.yaml?" -} ---------------------------------------------- -- | Package dependency oracle. newtype PkgDepsOracle = PkgDeps PackageName deriving (Show,Typeable,Eq,Hashable,Binary,NFData) -- | Stored on disk to know whether the flags have changed or any -- files have changed. data ConfigCache = ConfigCache { configCacheOpts :: !ConfigureOpts -- ^ All options used for this package. , configCacheDeps :: !(Set GhcPkgId) -- ^ The GhcPkgIds of all of the dependencies. Since Cabal doesn't take -- the complete GhcPkgId (only a PackageIdentifier) in the configure -- options, just using the previous value is insufficient to know if -- dependencies have changed. , configCacheComponents :: !(Set S.ByteString) -- ^ The components to be built. It's a bit of a hack to include this in -- here, as it's not a configure option (just a build option), but this -- is a convenient way to force compilation when the components change. , configCacheHaddock :: !Bool -- ^ Are haddocks to be built? } deriving (Generic,Eq,Show) instance Binary ConfigCache where put x = do -- magic string putWord8 1 putWord8 3 putWord8 4 putWord8 8 gput $ from x get = do 1 <- getWord8 3 <- getWord8 4 <- getWord8 8 <- getWord8 fmap to gget instance NFData ConfigCache instance HasStructuralInfo ConfigCache instance HasSemanticVersion ConfigCache -- | A task to perform when building data Task = Task { taskProvides :: !PackageIdentifier -- ^ the package/version to be built , taskType :: !TaskType -- ^ the task type, telling us how to build this , taskConfigOpts :: !TaskConfigOpts , taskPresent :: !(Map PackageIdentifier GhcPkgId) -- ^ GhcPkgIds of already-installed dependencies , taskAllInOne :: !Bool -- ^ indicates that the package can be built in one step } deriving Show -- | Given the IDs of any missing packages, produce the configure options data TaskConfigOpts = TaskConfigOpts { tcoMissing :: !(Set PackageIdentifier) -- ^ Dependencies for which we don't yet have an GhcPkgId , tcoOpts :: !(Map PackageIdentifier GhcPkgId -> ConfigureOpts) -- ^ Produce the list of options given the missing @GhcPkgId@s } instance Show TaskConfigOpts where show (TaskConfigOpts missing f) = concat [ "Missing: " , show missing , ". Without those: " , show $ f Map.empty ] -- | The type of a task, either building local code or something from the -- package index (upstream) data TaskType = TTLocal LocalPackage | TTUpstream Package InstallLocation (Maybe GitSHA1) deriving Show taskLocation :: Task -> InstallLocation taskLocation task = case taskType task of TTLocal _ -> Local TTUpstream _ loc _ -> loc -- | A complete plan of what needs to be built and how to do it data Plan = Plan { planTasks :: !(Map PackageName Task) , planFinals :: !(Map PackageName Task) -- ^ Final actions to be taken (test, benchmark, etc) , planUnregisterLocal :: !(Map GhcPkgId (PackageIdentifier, Maybe Text)) -- ^ Text is reason we're unregistering, for display only , planInstallExes :: !(Map Text InstallLocation) -- ^ Executables that should be installed after successful building } deriving Show -- | Basic information used to calculate what the configure options are data BaseConfigOpts = BaseConfigOpts { bcoSnapDB :: !(Path Abs Dir) , bcoLocalDB :: !(Path Abs Dir) , bcoSnapInstallRoot :: !(Path Abs Dir) , bcoLocalInstallRoot :: !(Path Abs Dir) , bcoBuildOpts :: !BuildOpts , bcoBuildOptsCLI :: !BuildOptsCLI , bcoExtraDBs :: ![(Path Abs Dir)] } deriving Show -- | Render a @BaseConfigOpts@ to an actual list of options configureOpts :: EnvConfig -> BaseConfigOpts -> Map PackageIdentifier GhcPkgId -- ^ dependencies -> Bool -- ^ local non-extra-dep? -> InstallLocation -> Package -> ConfigureOpts configureOpts econfig bco deps isLocal loc package = ConfigureOpts { coDirs = configureOptsDirs bco loc package , coNoDirs = configureOptsNoDir econfig bco deps isLocal package } -- options set by stack isStackOpt :: Text -> Bool isStackOpt t = any (`T.isPrefixOf` t) [ "--dependency=" , "--constraint=" , "--package-db=" , "--libdir=" , "--bindir=" , "--datadir=" , "--libexecdir=" , "--sysconfdir" , "--docdir=" , "--htmldir=" , "--haddockdir=" , "--enable-tests" , "--enable-benchmarks" , "--enable-library-profiling" , "--enable-executable-profiling" , "--exact-configuration" ] || elem t [ "--user" ] configureOptsDirs :: BaseConfigOpts -> InstallLocation -> Package -> [String] configureOptsDirs bco loc package = concat [ ["--user", "--package-db=clear", "--package-db=global"] , map (("--package-db=" ++) . toFilePathNoTrailingSep) $ case loc of Snap -> bcoExtraDBs bco ++ [bcoSnapDB bco] Local -> bcoExtraDBs bco ++ [bcoSnapDB bco] ++ [bcoLocalDB bco] , [ "--libdir=" ++ toFilePathNoTrailingSep (installRoot $(mkRelDir "lib")) , "--bindir=" ++ toFilePathNoTrailingSep (installRoot bindirSuffix) , "--datadir=" ++ toFilePathNoTrailingSep (installRoot $(mkRelDir "share")) , "--libexecdir=" ++ toFilePathNoTrailingSep (installRoot $(mkRelDir "libexec")) , "--sysconfdir=" ++ toFilePathNoTrailingSep (installRoot $(mkRelDir "etc")) , "--docdir=" ++ toFilePathNoTrailingSep docDir , "--htmldir=" ++ toFilePathNoTrailingSep docDir , "--haddockdir=" ++ toFilePathNoTrailingSep docDir] ] where installRoot = case loc of Snap -> bcoSnapInstallRoot bco Local -> bcoLocalInstallRoot bco docDir = case pkgVerDir of Nothing -> installRoot docDirSuffix Just dir -> installRoot docDirSuffix dir pkgVerDir = parseRelDir (packageIdentifierString (PackageIdentifier (packageName package) (packageVersion package)) ++ [pathSeparator]) -- | Same as 'configureOpts', but does not include directory path options configureOptsNoDir :: EnvConfig -> BaseConfigOpts -> Map PackageIdentifier GhcPkgId -- ^ dependencies -> Bool -- ^ is this a local, non-extra-dep? -> Package -> [String] configureOptsNoDir econfig bco deps isLocal package = concat [ depOptions , ["--enable-library-profiling" | boptsLibProfile bopts || boptsExeProfile bopts] , ["--enable-executable-profiling" | boptsExeProfile bopts && isLocal] , ["--enable-split-objs" | boptsSplitObjs bopts] , map (\(name,enabled) -> "-f" <> (if enabled then "" else "-") <> flagNameString name) (Map.toList flags) , concatMap (\x -> ["--ghc-options", T.unpack x]) (packageGhcOptions package) , map (("--extra-include-dirs=" ++) . T.unpack) (Set.toList (configExtraIncludeDirs config)) , map (("--extra-lib-dirs=" ++) . T.unpack) (Set.toList (configExtraLibDirs config)) , if whichCompiler (envConfigCompilerVersion econfig) == Ghcjs then ["--ghcjs"] else [] , if useExactConf then ["--exact-configuration"] else [] ] where config = getConfig econfig bopts = bcoBuildOpts bco -- TODO: instead always enable this when the cabal version is new -- enough. That way we'll detect bugs with --exact-configuration -- earlier. Cabal also might do less work then. useExactConf = configAllowNewer config newerCabal = envConfigCabalVersion econfig >= $(mkVersion "1.22") -- Unioning atop defaults is needed so that all flags are specified -- with --exact-configuration. flags | useExactConf = packageFlags package `Map.union` packageDefaultFlags package | otherwise = packageFlags package depOptions = map (uncurry toDepOption) $ Map.toList deps where toDepOption = if newerCabal then toDepOption1_22 else toDepOption1_18 toDepOption1_22 ident gid = concat [ "--dependency=" , packageNameString $ packageIdentifierName ident , "=" , ghcPkgIdString gid ] toDepOption1_18 ident _gid = concat [ "--constraint=" , packageNameString name , "==" , versionString version ] where PackageIdentifier name version = ident -- | Get set of wanted package names from locals. wantedLocalPackages :: [LocalPackage] -> Set PackageName wantedLocalPackages = Set.fromList . map (packageName . lpPackage) . filter lpWanted -- | One-way conversion to serialized time. modTime :: UTCTime -> ModTime modTime x = ModTime ( toModifiedJulianDay (utctDay x) , toRational (utctDayTime x)) -- | Configure options to be sent to Setup.hs configure data ConfigureOpts = ConfigureOpts { coDirs :: ![String] -- ^ Options related to various paths. We separate these out since they do -- not have an impact on the contents of the compiled binary for checking -- if we can use an existing precompiled cache. , coNoDirs :: ![String] } deriving (Show, Eq, Generic) instance Binary ConfigureOpts instance HasStructuralInfo ConfigureOpts instance NFData ConfigureOpts -- | Information on a compiled package: the library conf file (if relevant), -- and all of the executable paths. data PrecompiledCache = PrecompiledCache -- Use FilePath instead of Path Abs File for Binary instances { pcLibrary :: !(Maybe FilePath) -- ^ .conf file inside the package database , pcExes :: ![FilePath] -- ^ Full paths to executables } deriving (Show, Eq, Generic) instance Binary PrecompiledCache instance HasSemanticVersion PrecompiledCache instance HasStructuralInfo PrecompiledCache instance NFData PrecompiledCache stack-1.1.2/src/Stack/Types/BuildPlan.hs0000644000000000000000000004111712717707441016172 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleInstances #-} -- | Shared types for various stackage packages. module Stack.Types.BuildPlan ( -- * Types BuildPlan (..) , PackagePlan (..) , PackageConstraints (..) , TestState (..) , SystemInfo (..) , Maintainer (..) , ExeName (..) , SimpleDesc (..) , Snapshots (..) , DepInfo (..) , Component (..) , SnapName (..) , MiniBuildPlan (..) , MiniPackageInfo (..) , CabalFileInfo (..) , GitSHA1 (..) , renderSnapName , parseSnapName , SnapshotHash (..) , trimmedSnapshotHash ) where import Control.Applicative import Control.Arrow ((&&&)) import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow, throwM) import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, withText, (.!=), (.:), (.:?), (.=)) import Data.Binary.VersionTagged import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Hashable (Hashable) import qualified Data.HashMap.Strict as HashMap import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (fromMaybe) import Data.Monoid import Data.Set (Set) import Data.String (IsString, fromString) import Data.Text (Text, pack, unpack) import qualified Data.Text as T import Data.Text.Read (decimal) import Data.Time (Day) import qualified Data.Traversable as T import Data.Typeable (TypeRep, Typeable, typeOf) import Data.Vector (Vector) import Distribution.System (Arch, OS (..)) import qualified Distribution.Text as DT import qualified Distribution.Version as C import GHC.Generics (Generic) import Prelude -- Fix AMP warning import Safe (readMay) import Stack.Types.Compiler import Stack.Types.FlagName import Stack.Types.PackageName import Stack.Types.Version -- | The name of an LTS Haskell or Stackage Nightly snapshot. data SnapName = LTS !Int !Int | Nightly !Day deriving (Show, Eq, Ord) data BuildPlan = BuildPlan { bpSystemInfo :: SystemInfo , bpTools :: Vector (PackageName, Version) , bpPackages :: Map PackageName PackagePlan , bpGithubUsers :: Map Text (Set Text) } deriving (Show, Eq) instance ToJSON BuildPlan where toJSON BuildPlan {..} = object [ "system-info" .= bpSystemInfo , "tools" .= fmap goTool bpTools , "packages" .= bpPackages , "github-users" .= bpGithubUsers ] where goTool (k, v) = object [ "name" .= k , "version" .= v ] instance FromJSON BuildPlan where parseJSON = withObject "BuildPlan" $ \o -> do bpSystemInfo <- o .: "system-info" bpTools <- o .: "tools" >>= T.mapM goTool bpPackages <- o .: "packages" bpGithubUsers <- o .:? "github-users" .!= mempty return BuildPlan {..} where goTool = withObject "Tool" $ \o -> (,) <$> o .: "name" <*> o .: "version" data PackagePlan = PackagePlan { ppVersion :: Version , ppCabalFileInfo :: Maybe CabalFileInfo , ppGithubPings :: Set Text , ppUsers :: Set PackageName , ppConstraints :: PackageConstraints , ppDesc :: SimpleDesc } deriving (Show, Eq) instance ToJSON PackagePlan where toJSON PackagePlan {..} = object $ maybe id (\cfi -> (("cabal-file-info" .= cfi):)) ppCabalFileInfo $ [ "version" .= ppVersion , "github-pings" .= ppGithubPings , "users" .= ppUsers , "constraints" .= ppConstraints , "description" .= ppDesc ] instance FromJSON PackagePlan where parseJSON = withObject "PackageBuild" $ \o -> do ppVersion <- o .: "version" ppCabalFileInfo <- o .:? "cabal-file-info" ppGithubPings <- o .:? "github-pings" .!= mempty ppUsers <- o .:? "users" .!= mempty ppConstraints <- o .: "constraints" ppDesc <- o .: "description" return PackagePlan {..} -- | Information on the contents of a cabal file data CabalFileInfo = CabalFileInfo { cfiSize :: !Int -- ^ File size in bytes , cfiHashes :: !(Map.Map Text Text) -- ^ Various hashes of the file contents } deriving (Show, Eq, Generic) instance ToJSON CabalFileInfo where toJSON CabalFileInfo {..} = object [ "size" .= cfiSize , "hashes" .= cfiHashes ] instance FromJSON CabalFileInfo where parseJSON = withObject "CabalFileInfo" $ \o -> do cfiSize <- o .: "size" cfiHashes <- o .: "hashes" return CabalFileInfo {..} display :: DT.Text a => a -> Text display = fromString . DT.display simpleParse :: (MonadThrow m, DT.Text a, Typeable a) => Text -> m a simpleParse orig = withTypeRep $ \rep -> case DT.simpleParse str of Nothing -> throwM (ParseFailedException rep (pack str)) Just v -> return v where str = unpack orig withTypeRep :: Typeable a => (TypeRep -> m a) -> m a withTypeRep f = res where res = f (typeOf (unwrap res)) unwrap :: m a -> a unwrap _ = error "unwrap" data BuildPlanTypesException = ParseSnapNameException Text | ParseFailedException TypeRep Text deriving Typeable instance Exception BuildPlanTypesException instance Show BuildPlanTypesException where show (ParseSnapNameException t) = "Invalid snapshot name: " ++ T.unpack t show (ParseFailedException rep t) = "Unable to parse " ++ show t ++ " as " ++ show rep data PackageConstraints = PackageConstraints { pcVersionRange :: VersionRange , pcMaintainer :: Maybe Maintainer , pcTests :: TestState , pcHaddocks :: TestState , pcBuildBenchmarks :: Bool , pcFlagOverrides :: Map FlagName Bool , pcEnableLibProfile :: Bool } deriving (Show, Eq) instance ToJSON PackageConstraints where toJSON PackageConstraints {..} = object $ addMaintainer [ "version-range" .= display pcVersionRange , "tests" .= pcTests , "haddocks" .= pcHaddocks , "build-benchmarks" .= pcBuildBenchmarks , "flags" .= pcFlagOverrides , "library-profiling" .= pcEnableLibProfile ] where addMaintainer = maybe id (\m -> (("maintainer" .= m):)) pcMaintainer instance FromJSON PackageConstraints where parseJSON = withObject "PackageConstraints" $ \o -> do pcVersionRange <- (o .: "version-range") >>= either (fail . show) return . simpleParse pcTests <- o .: "tests" pcHaddocks <- o .: "haddocks" pcBuildBenchmarks <- o .: "build-benchmarks" pcFlagOverrides <- o .: "flags" pcMaintainer <- o .:? "maintainer" pcEnableLibProfile <- fmap (fromMaybe True) (o .:? "library-profiling") return PackageConstraints {..} data TestState = ExpectSuccess | ExpectFailure | Don'tBuild -- ^ when the test suite will pull in things we don't want deriving (Show, Eq, Ord, Bounded, Enum) testStateToText :: TestState -> Text testStateToText ExpectSuccess = "expect-success" testStateToText ExpectFailure = "expect-failure" testStateToText Don'tBuild = "do-not-build" instance ToJSON TestState where toJSON = toJSON . testStateToText instance FromJSON TestState where parseJSON = withText "TestState" $ \t -> case HashMap.lookup t states of Nothing -> fail $ "Invalid state: " ++ unpack t Just v -> return v where states = HashMap.fromList $ map (\x -> (testStateToText x, x)) [minBound..maxBound] data SystemInfo = SystemInfo { siCompilerVersion :: CompilerVersion , siOS :: OS , siArch :: Arch , siCorePackages :: Map PackageName Version , siCoreExecutables :: Set ExeName } deriving (Show, Eq, Ord) instance ToJSON SystemInfo where toJSON SystemInfo {..} = object $ (case siCompilerVersion of GhcVersion version -> "ghc-version" .= version _ -> "compiler-version" .= siCompilerVersion) : [ "os" .= display siOS , "arch" .= display siArch , "core-packages" .= siCorePackages , "core-executables" .= siCoreExecutables ] instance FromJSON SystemInfo where parseJSON = withObject "SystemInfo" $ \o -> do let helper name = (o .: name) >>= either (fail . show) return . simpleParse ghcVersion <- o .:? "ghc-version" compilerVersion <- o .:? "compiler-version" siCompilerVersion <- case (ghcVersion, compilerVersion) of (Just _, Just _) -> fail "can't have both compiler-version and ghc-version fields" (Just ghc, _) -> return (GhcVersion ghc) (_, Just compiler) -> return compiler _ -> fail "expected field \"ghc-version\" or \"compiler-version\" not present" siOS <- helper "os" siArch <- helper "arch" siCorePackages <- o .: "core-packages" siCoreExecutables <- o .: "core-executables" return SystemInfo {..} newtype Maintainer = Maintainer { unMaintainer :: Text } deriving (Show, Eq, Ord, Hashable, ToJSON, FromJSON, IsString) -- | Name of an executable. newtype ExeName = ExeName { unExeName :: Text } deriving (Show, Eq, Ord, Hashable, IsString, Generic, Binary, NFData) instance HasStructuralInfo ExeName instance ToJSON ExeName where toJSON = toJSON . unExeName instance FromJSON ExeName where parseJSON = withText "ExeName" $ return . ExeName -- | A simplified package description that tracks: -- -- * Package dependencies -- -- * Build tool dependencies -- -- * Provided executables -- -- It has fully resolved all conditionals data SimpleDesc = SimpleDesc { sdPackages :: Map PackageName DepInfo , sdTools :: Map ExeName DepInfo , sdProvidedExes :: Set ExeName , sdModules :: Set Text -- ^ modules exported by the library } deriving (Show, Eq) instance Monoid SimpleDesc where mempty = SimpleDesc mempty mempty mempty mempty mappend (SimpleDesc a b c d) (SimpleDesc w x y z) = SimpleDesc (Map.unionWith (<>) a w) (Map.unionWith (<>) b x) (c <> y) (d <> z) instance ToJSON SimpleDesc where toJSON SimpleDesc {..} = object [ "packages" .= sdPackages , "tools" .= sdTools , "provided-exes" .= sdProvidedExes , "modules" .= sdModules ] instance FromJSON SimpleDesc where parseJSON = withObject "SimpleDesc" $ \o -> do sdPackages <- o .: "packages" sdTools <- o .: "tools" sdProvidedExes <- o .: "provided-exes" sdModules <- o .: "modules" return SimpleDesc {..} data DepInfo = DepInfo { diComponents :: Set Component , diRange :: VersionRange } deriving (Show, Eq) instance Monoid DepInfo where mempty = DepInfo mempty C.anyVersion DepInfo a x `mappend` DepInfo b y = DepInfo (mappend a b) (C.intersectVersionRanges x y) instance ToJSON DepInfo where toJSON DepInfo {..} = object [ "components" .= diComponents , "range" .= display diRange ] instance FromJSON DepInfo where parseJSON = withObject "DepInfo" $ \o -> do diComponents <- o .: "components" diRange <- o .: "range" >>= either (fail . show) return . simpleParse return DepInfo {..} data Component = CompLibrary | CompExecutable | CompTestSuite | CompBenchmark deriving (Show, Read, Eq, Ord, Enum, Bounded) compToText :: Component -> Text compToText CompLibrary = "library" compToText CompExecutable = "executable" compToText CompTestSuite = "test-suite" compToText CompBenchmark = "benchmark" instance ToJSON Component where toJSON = toJSON . compToText instance FromJSON Component where parseJSON = withText "Component" $ \t -> maybe (fail $ "Invalid component: " ++ unpack t) return (HashMap.lookup t comps) where comps = HashMap.fromList $ map (compToText &&& id) [minBound..maxBound] -- | Convert a 'SnapName' into its short representation, e.g. @lts-2.8@, -- @nightly-2015-03-05@. renderSnapName :: SnapName -> Text renderSnapName (LTS x y) = T.pack $ concat ["lts-", show x, ".", show y] renderSnapName (Nightly d) = T.pack $ "nightly-" ++ show d -- | Parse the short representation of a 'SnapName'. parseSnapName :: MonadThrow m => Text -> m SnapName parseSnapName t0 = case lts <|> nightly of Nothing -> throwM $ ParseSnapNameException t0 Just sn -> return sn where lts = do t1 <- T.stripPrefix "lts-" t0 Right (x, t2) <- Just $ decimal t1 t3 <- T.stripPrefix "." t2 Right (y, "") <- Just $ decimal t3 return $ LTS x y nightly = do t1 <- T.stripPrefix "nightly-" t0 Nightly <$> readMay (T.unpack t1) -- | Most recent Nightly and newest LTS version per major release. data Snapshots = Snapshots { snapshotsNightly :: !Day , snapshotsLts :: !(IntMap Int) } deriving Show instance FromJSON Snapshots where parseJSON = withObject "Snapshots" $ \o -> Snapshots <$> (o .: "nightly" >>= parseNightly) <*> (fmap IntMap.unions $ mapM (parseLTS . snd) $ filter (isLTS . fst) $ HashMap.toList o) where parseNightly t = case parseSnapName t of Left e -> fail $ show e Right (LTS _ _) -> fail "Unexpected LTS value" Right (Nightly d) -> return d isLTS = ("lts-" `T.isPrefixOf`) parseLTS = withText "LTS" $ \t -> case parseSnapName t of Left e -> fail $ show e Right (LTS x y) -> return $ IntMap.singleton x y Right (Nightly _) -> fail "Unexpected nightly value" instance ToJSON a => ToJSON (Map ExeName a) where toJSON = toJSON . Map.mapKeysWith const unExeName instance FromJSON a => FromJSON (Map ExeName a) where parseJSON = fmap (Map.mapKeysWith const ExeName) . parseJSON -- | A simplified version of the 'BuildPlan' + cabal file. data MiniBuildPlan = MiniBuildPlan { mbpCompilerVersion :: !CompilerVersion , mbpPackages :: !(Map PackageName MiniPackageInfo) } deriving (Generic, Show, Eq) instance Binary MiniBuildPlan instance NFData MiniBuildPlan instance HasStructuralInfo MiniBuildPlan instance HasSemanticVersion MiniBuildPlan -- | Information on a single package for the 'MiniBuildPlan'. data MiniPackageInfo = MiniPackageInfo { mpiVersion :: !Version , mpiFlags :: !(Map FlagName Bool) , mpiGhcOptions :: ![Text] , mpiPackageDeps :: !(Set PackageName) , mpiToolDeps :: !(Set Text) -- ^ Due to ambiguity in Cabal, it is unclear whether this refers to the -- executable name, the package name, or something else. We have to guess -- based on what's available, which is why we store this is an unwrapped -- 'Text'. , mpiExes :: !(Set ExeName) -- ^ Executables provided by this package , mpiHasLibrary :: !Bool -- ^ Is there a library present? , mpiGitSHA1 :: !(Maybe GitSHA1) -- ^ An optional SHA1 representation in hex format of the blob containing -- the cabal file contents. Useful for grabbing the correct cabal file -- revision directly from a Git repo } deriving (Generic, Show, Eq) instance Binary MiniPackageInfo instance HasStructuralInfo MiniPackageInfo instance NFData MiniPackageInfo newtype GitSHA1 = GitSHA1 ByteString deriving (Generic, Show, Eq, NFData, HasStructuralInfo, Binary) newtype SnapshotHash = SnapshotHash { unShapshotHash :: ByteString } deriving (Generic, Show, Eq) trimmedSnapshotHash :: SnapshotHash -> ByteString trimmedSnapshotHash = BS.take 12 . unShapshotHash stack-1.1.2/src/Stack/Types/Urls.hs0000644000000000000000000000244612717707441015247 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} module Stack.Types.Urls where import Control.Applicative import Data.Aeson.Extended import Data.Text (Text) import Data.Monoid import GHC.Generics (Generic) import Generics.Deriving.Monoid (memptydefault, mappenddefault) import Prelude data Urls = Urls { urlsLatestSnapshot :: !Text , urlsLtsBuildPlans :: !Text , urlsNightlyBuildPlans :: !Text } deriving Show -- TODO: Really need this instance? instance FromJSON (WithJSONWarnings Urls) where parseJSON = withObjectWarnings "Urls" $ \o -> do Urls <$> o ..: "latest-snapshot" <*> o ..: "lts-build-plans" <*> o ..: "nightly-build-plans" data UrlsMonoid = UrlsMonoid { urlsMonoidLatestSnapshot :: !(First Text) , urlsMonoidLtsBuildPlans :: !(First Text) , urlsMonoidNightlyBuildPlans :: !(First Text) } deriving (Show, Generic) instance FromJSON (WithJSONWarnings UrlsMonoid) where parseJSON = withObjectWarnings "UrlsMonoid" $ \o -> do UrlsMonoid <$> o ..: "latest-snapshot" <*> o ..: "lts-build-plans" <*> o ..: "nightly-build-plans" instance Monoid UrlsMonoid where mempty = memptydefault mappend = mappenddefault stack-1.1.2/src/Stack/Types/Compiler.hs0000644000000000000000000000732112615132707016063 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} module Stack.Types.Compiler where import Control.DeepSeq import Data.Aeson import Data.Binary.VersionTagged (Binary, HasStructuralInfo) import Data.Map (Map) import qualified Data.Map as Map import Data.Monoid ((<>)) import qualified Data.Text as T import GHC.Generics (Generic) import Stack.Types.Version -- | Variety of compiler to use. data WhichCompiler = Ghc | Ghcjs deriving (Show, Eq, Ord) -- | Specifies a compiler and its version number(s). -- -- Note that despite having this datatype, stack isn't in a hurry to -- support compilers other than GHC. -- -- NOTE: updating this will change its binary serialization. The -- version number in the 'BinarySchema' instance for 'MiniBuildPlan' -- should be updated. data CompilerVersion = GhcVersion {-# UNPACK #-} !Version | GhcjsVersion {-# UNPACK #-} !Version -- GHCJS version {-# UNPACK #-} !Version -- GHC version deriving (Generic, Show, Eq, Ord) instance Binary CompilerVersion instance HasStructuralInfo CompilerVersion instance NFData CompilerVersion instance ToJSON CompilerVersion where toJSON = toJSON . compilerVersionText instance FromJSON CompilerVersion where parseJSON (String t) = maybe (fail "Failed to parse compiler version") return (parseCompilerVersion t) parseJSON _ = fail "Invalid CompilerVersion, must be String" instance FromJSON a => FromJSON (Map CompilerVersion a) where -- TODO: Dedupe with similar code in Stack.Types.Version? -- -- Maybe this ought to be abstracted into a 'JSONKey' class, so that a -- fully generic definition for Map can be provided. parseJSON val = do m <- parseJSON val fmap Map.fromList $ mapM go $ Map.toList m where go (k, v) = do let mparsed = parseCompilerVersion (T.pack k) case mparsed of Nothing -> fail $ "Failed to parse CompilerVersion " ++ k Just parsed -> return (parsed, v) parseCompilerVersion :: T.Text -> Maybe CompilerVersion parseCompilerVersion t | Just t' <- T.stripPrefix "ghc-" t , Just v <- parseVersionFromString $ T.unpack t' = Just (GhcVersion v) | Just t' <- T.stripPrefix "ghcjs-" t , [tghcjs, tghc] <- T.splitOn "_ghc-" t' , Just vghcjs <- parseVersionFromString $ T.unpack tghcjs , Just vghc <- parseVersionFromString $ T.unpack tghc = Just (GhcjsVersion vghcjs vghc) | otherwise = Nothing compilerVersionText :: CompilerVersion -> T.Text compilerVersionText (GhcVersion vghc) = "ghc-" <> versionText vghc compilerVersionText (GhcjsVersion vghcjs vghc) = "ghcjs-" <> versionText vghcjs <> "_ghc-" <> versionText vghc compilerVersionString :: CompilerVersion -> String compilerVersionString = T.unpack . compilerVersionText whichCompiler :: CompilerVersion -> WhichCompiler whichCompiler GhcVersion {} = Ghc whichCompiler GhcjsVersion {} = Ghcjs isWantedCompiler :: VersionCheck -> CompilerVersion -> CompilerVersion -> Bool isWantedCompiler check (GhcVersion wanted) (GhcVersion actual) = checkVersion check wanted actual isWantedCompiler check (GhcjsVersion wanted wantedGhc) (GhcjsVersion actual actualGhc) = checkVersion check wanted actual && checkVersion check wantedGhc actualGhc isWantedCompiler _ _ _ = False getGhcVersion :: CompilerVersion -> Version getGhcVersion (GhcVersion v) = v getGhcVersion (GhcjsVersion _ v) = v compilerExeName :: WhichCompiler -> String compilerExeName Ghc = "ghc" compilerExeName Ghcjs = "ghcjs" haddockExeName :: WhichCompiler -> String haddockExeName Ghc = "haddock" haddockExeName Ghcjs = "haddock-ghcjs" stack-1.1.2/src/Stack/Types/Config.hs0000644000000000000000000021300612717707441015523 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE StandaloneDeriving #-} -- | The Config type. module Stack.Types.Config ( -- * Main configuration types and classes -- ** HasPlatform & HasStackRoot HasPlatform(..) ,HasStackRoot(..) ,PlatformVariant(..) -- ** Config & HasConfig ,Config(..) ,HasConfig(..) ,askConfig ,askLatestSnapshotUrl ,explicitSetupDeps ,getMinimalEnvOverride -- ** BuildConfig & HasBuildConfig ,BuildConfig(..) ,bcRoot ,bcWorkDir ,bcWantedCompiler ,HasBuildConfig(..) -- ** GHCVariant & HasGHCVariant ,GHCVariant(..) ,ghcVariantName ,ghcVariantSuffix ,parseGHCVariant ,HasGHCVariant(..) ,snapshotsDir -- ** EnvConfig & HasEnvConfig ,EnvConfig(..) ,HasEnvConfig(..) ,getWhichCompiler ,getCompilerPath -- * Details -- ** ApplyGhcOptions ,ApplyGhcOptions(..) -- ** ConfigException ,ConfigException(..) -- ** WhichSolverCmd ,WhichSolverCmd(..) -- ** ConfigMonoid ,ConfigMonoid(..) -- ** EnvSettings ,EnvSettings(..) ,minimalEnvSettings -- ** GlobalOpts & GlobalOptsMonoid ,GlobalOpts(..) ,GlobalOptsMonoid(..) ,defaultLogLevel -- ** LoadConfig ,LoadConfig(..) -- ** PackageEntry & PackageLocation ,PackageEntry(..) ,TreatLikeExtraDep ,PackageLocation(..) ,RemotePackageType(..) -- ** PackageIndex, IndexName & IndexLocation ,PackageIndex(..) ,IndexName(..) ,configPackageIndex ,configPackageIndexCache ,configPackageIndexGz ,configPackageIndexRoot ,configPackageIndexRepo ,configPackageTarball ,indexNameText ,IndexLocation(..) -- ** Project & ProjectAndConfigMonoid ,Project(..) ,ProjectAndConfigMonoid(..) -- ** PvpBounds ,PvpBounds(..) ,parsePvpBounds -- ** Resolver & AbstractResolver ,Resolver ,LoadedResolver ,ResolverThat's(..) ,parseResolverText ,resolverDirName ,resolverName ,customResolverHash ,toResolverNotLoaded ,AbstractResolver(..) -- ** SCM ,SCM(..) -- ** CustomSnapshot ,CustomSnapshot(..) -- ** GhcOptions ,GhcOptions(..) ,ghcOptionsFor -- ** PackageFlags ,PackageFlags(..) -- * Paths ,bindirSuffix ,configInstalledCache ,configMiniBuildPlanCache ,getProjectWorkDir ,docDirSuffix ,flagCacheLocal ,extraBinDirs ,hpcReportDir ,installationRootDeps ,installationRootLocal ,packageDatabaseDeps ,packageDatabaseExtra ,packageDatabaseLocal ,platformOnlyRelDir ,platformGhcRelDir ,useShaPathOnWindows ,getWorkDir -- * Command-specific types -- ** Eval ,EvalOpts(..) -- ** Exec ,ExecOpts(..) ,SpecialExecCmd(..) ,ExecOptsExtra(..) -- ** Setup ,DownloadInfo(..) ,VersionedDownloadInfo(..) ,SetupInfo(..) ,SetupInfoLocation(..) -- ** Docker entrypoint ,DockerEntrypoint(..) ,DockerUser(..) ,module X ) where import Control.Applicative import Control.Arrow ((&&&)) import Control.Exception import Control.Monad (liftM, mzero, forM, join) import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.Logger (LogLevel(..)) import Control.Monad.Reader (MonadReader, ask, asks, MonadIO, liftIO) import Data.Aeson.Extended (ToJSON, toJSON, FromJSON, parseJSON, withText, object, (.=), (..:), (..:?), (..!=), Value(String, Object), withObjectWarnings, WarningParser, Object, jsonSubWarnings, jsonSubWarningsT, jsonSubWarningsTT, WithJSONWarnings(..), noJSONWarnings) import Data.Attoparsec.Args import Data.Binary (Binary) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as S8 import Data.Either (partitionEithers) import Data.IORef (IORef) import Data.List (stripPrefix) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty import Data.Hashable (Hashable) import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Map.Strict as M import Data.Maybe import Data.Monoid.Extra import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Data.Typeable import Data.Yaml (ParseException) import Distribution.System (Platform) import qualified Distribution.Text import Distribution.Version (anyVersion) import GHC.Generics (Generic) import Generics.Deriving.Monoid (memptydefault, mappenddefault) import Network.HTTP.Client (parseUrl) import Path import qualified Paths_stack as Meta import Stack.Types.BuildPlan (MiniBuildPlan(..), SnapName, renderSnapName, parseSnapName, SnapshotHash (..), trimmedSnapshotHash) import Stack.Types.Urls import Stack.Types.Compiler import Stack.Types.Docker import Stack.Types.Nix import Stack.Types.FlagName import Stack.Types.Image import Stack.Types.PackageIdentifier import Stack.Types.PackageIndex import Stack.Types.PackageName import Stack.Types.TemplateName import Stack.Types.Version import System.FilePath (takeBaseName) import System.PosixCompat.Types (UserID, GroupID, FileMode) import System.Process.Read (EnvOverride, findExecutable) -- Re-exports import Stack.Types.Config.Build as X #ifdef mingw32_HOST_OS import qualified Crypto.Hash.SHA1 as SHA1 import qualified Data.ByteString.Base16 as B16 #endif -- | The top-level Stackage configuration. data Config = Config {configStackRoot :: !(Path Abs Dir) -- ^ ~/.stack more often than not ,configWorkDir :: !(Path Rel Dir) -- ^ this allows to override .stack-work directory ,configUserConfigPath :: !(Path Abs File) -- ^ Path to user configuration file (usually ~/.stack/config.yaml) ,configBuild :: !BuildOpts -- ^ Build configuration ,configDocker :: !DockerOpts -- ^ Docker configuration ,configNix :: !NixOpts -- ^ Execution environment (e.g nix-shell) configuration ,configEnvOverride :: !(EnvSettings -> IO EnvOverride) -- ^ Environment variables to be passed to external tools ,configLocalProgramsBase :: !(Path Abs Dir) -- ^ Non-platform-specific path containing local installations ,configLocalPrograms :: !(Path Abs Dir) -- ^ Path containing local installations (mainly GHC) ,configConnectionCount :: !Int -- ^ How many concurrent connections are allowed when downloading ,configHideTHLoading :: !Bool -- ^ Hide the Template Haskell "Loading package ..." messages from the -- console ,configPlatform :: !Platform -- ^ The platform we're building for, used in many directory names ,configPlatformVariant :: !PlatformVariant -- ^ Variant of the platform, also used in directory names ,configGHCVariant0 :: !(Maybe GHCVariant) -- ^ The variant of GHC requested by the user. -- In most cases, use 'BuildConfig' or 'MiniConfig's version instead, -- which will have an auto-detected default. ,configUrls :: !Urls -- ^ URLs for other files used by stack. -- TODO: Better document -- e.g. The latest snapshot file. -- A build plan name (e.g. lts5.9.yaml) is appended when downloading -- the build plan actually. ,configPackageIndices :: ![PackageIndex] -- ^ Information on package indices. This is left biased, meaning that -- packages in an earlier index will shadow those in a later index. -- -- Warning: if you override packages in an index vs what's available -- upstream, you may correct your compiled snapshots, as different -- projects may have different definitions of what pkg-ver means! This -- feature is primarily intended for adding local packages, not -- overriding. Overriding is better accomplished by adding to your -- list of packages. -- -- Note that indices specified in a later config file will override -- previous indices, /not/ extend them. -- -- Using an assoc list instead of a Map to keep track of priority ,configSystemGHC :: !Bool -- ^ Should we use the system-installed GHC (on the PATH) if -- available? Can be overridden by command line options. ,configInstallGHC :: !Bool -- ^ Should we automatically install GHC if missing or the wrong -- version is available? Can be overridden by command line options. ,configSkipGHCCheck :: !Bool -- ^ Don't bother checking the GHC version or architecture. ,configSkipMsys :: !Bool -- ^ On Windows: don't use a locally installed MSYS ,configCompilerCheck :: !VersionCheck -- ^ Specifies which versions of the compiler are acceptable. ,configLocalBin :: !(Path Abs Dir) -- ^ Directory we should install executables into ,configRequireStackVersion :: !VersionRange -- ^ Require a version of stack within this range. ,configJobs :: !Int -- ^ How many concurrent jobs to run, defaults to number of capabilities ,configExtraIncludeDirs :: !(Set Text) -- ^ --extra-include-dirs arguments ,configExtraLibDirs :: !(Set Text) -- ^ --extra-lib-dirs arguments ,configConcurrentTests :: !Bool -- ^ Run test suites concurrently ,configImage :: !ImageOpts ,configTemplateParams :: !(Map Text Text) -- ^ Parameters for templates. ,configScmInit :: !(Maybe SCM) -- ^ Initialize SCM (e.g. git) when creating new projects. ,configGhcOptions :: !GhcOptions -- ^ Additional GHC options to apply to either all packages (Nothing) -- or a specific package (Just). ,configSetupInfoLocations :: ![SetupInfoLocation] -- ^ Additional SetupInfo (inline or remote) to use to find tools. ,configPvpBounds :: !PvpBounds -- ^ How PVP upper bounds should be added to packages ,configModifyCodePage :: !Bool -- ^ Force the code page to UTF-8 on Windows ,configExplicitSetupDeps :: !(Map (Maybe PackageName) Bool) -- ^ See 'explicitSetupDeps'. 'Nothing' provides the default value. ,configRebuildGhcOptions :: !Bool -- ^ Rebuild on GHC options changes ,configApplyGhcOptions :: !ApplyGhcOptions -- ^ Which packages to ghc-options on the command line apply to? ,configAllowNewer :: !Bool -- ^ Ignore version ranges in .cabal files. Funny naming chosen to -- match cabal. ,configDefaultTemplate :: !(Maybe TemplateName) -- ^ The default template to use when none is specified. -- (If Nothing, the default default is used.) ,configAllowDifferentUser :: !Bool -- ^ Allow users other than the stack root owner to use the stack -- installation. ,configPackageCaches :: !(IORef (Maybe (Map PackageIdentifier (PackageIndex, PackageCache)))) -- ^ In memory cache of hackage index. ,configMaybeProject :: !(Maybe (Project, Path Abs File)) } -- | Which packages to ghc-options on the command line apply to? data ApplyGhcOptions = AGOTargets -- ^ all local targets | AGOLocals -- ^ all local packages, even non-targets | AGOEverything -- ^ every package deriving (Show, Read, Eq, Ord, Enum, Bounded) instance FromJSON ApplyGhcOptions where parseJSON = withText "ApplyGhcOptions" $ \t -> case t of "targets" -> return AGOTargets "locals" -> return AGOLocals "everything" -> return AGOEverything _ -> fail $ "Invalid ApplyGhcOptions: " ++ show t -- | Information on a single package index data PackageIndex = PackageIndex { indexName :: !IndexName , indexLocation :: !IndexLocation , indexDownloadPrefix :: !Text -- ^ URL prefix for downloading packages , indexGpgVerify :: !Bool -- ^ GPG-verify the package index during download. Only applies to Git -- repositories for now. , indexRequireHashes :: !Bool -- ^ Require that hashes and package size information be available for packages in this index } deriving Show instance FromJSON (WithJSONWarnings PackageIndex) where parseJSON = withObjectWarnings "PackageIndex" $ \o -> do name <- o ..: "name" prefix <- o ..: "download-prefix" mgit <- o ..:? "git" mhttp <- o ..:? "http" loc <- case (mgit, mhttp) of (Nothing, Nothing) -> fail $ "Must provide either Git or HTTP URL for " ++ T.unpack (indexNameText name) (Just git, Nothing) -> return $ ILGit git (Nothing, Just http) -> return $ ILHttp http (Just git, Just http) -> return $ ILGitHttp git http gpgVerify <- o ..:? "gpg-verify" ..!= False reqHashes <- o ..:? "require-hashes" ..!= False return PackageIndex { indexName = name , indexLocation = loc , indexDownloadPrefix = prefix , indexGpgVerify = gpgVerify , indexRequireHashes = reqHashes } -- | Unique name for a package index newtype IndexName = IndexName { unIndexName :: ByteString } deriving (Show, Eq, Ord, Hashable, Binary) indexNameText :: IndexName -> Text indexNameText = decodeUtf8 . unIndexName instance ToJSON IndexName where toJSON = toJSON . indexNameText instance FromJSON IndexName where parseJSON = withText "IndexName" $ \t -> case parseRelDir (T.unpack t) of Left e -> fail $ "Invalid index name: " ++ show e Right _ -> return $ IndexName $ encodeUtf8 t -- | Location of the package index. This ensures that at least one of Git or -- HTTP is available. data IndexLocation = ILGit !Text | ILHttp !Text | ILGitHttp !Text !Text deriving (Show, Eq, Ord) -- | Controls which version of the environment is used data EnvSettings = EnvSettings { esIncludeLocals :: !Bool -- ^ include local project bin directory, GHC_PACKAGE_PATH, etc , esIncludeGhcPackagePath :: !Bool -- ^ include the GHC_PACKAGE_PATH variable , esStackExe :: !Bool -- ^ set the STACK_EXE variable to the current executable name , esLocaleUtf8 :: !Bool -- ^ set the locale to C.UTF-8 } deriving (Show, Eq, Ord) data ExecOpts = ExecOpts { eoCmd :: !SpecialExecCmd , eoArgs :: ![String] , eoExtra :: !ExecOptsExtra } deriving (Show) data SpecialExecCmd = ExecCmd String | ExecGhc | ExecRunGhc deriving (Show, Eq) data ExecOptsExtra = ExecOptsPlain | ExecOptsEmbellished { eoEnvSettings :: !EnvSettings , eoPackages :: ![String] } deriving (Show) data EvalOpts = EvalOpts { evalArg :: !String , evalExtra :: !ExecOptsExtra } deriving (Show) -- | Parsed global command-line options. data GlobalOpts = GlobalOpts { globalReExecVersion :: !(Maybe String) -- ^ Expected re-exec in container version , globalDockerEntrypoint :: !(Maybe DockerEntrypoint) -- ^ Data used when stack is acting as a Docker entrypoint (internal use only) , globalLogLevel :: !LogLevel -- ^ Log level , globalConfigMonoid :: !ConfigMonoid -- ^ Config monoid, for passing into 'loadConfig' , globalResolver :: !(Maybe AbstractResolver) -- ^ Resolver override , globalCompiler :: !(Maybe CompilerVersion) -- ^ Compiler override , globalTerminal :: !Bool -- ^ We're in a terminal? , globalStackYaml :: !(Maybe FilePath) -- ^ Override project stack.yaml } deriving (Show) -- | Parsed global command-line options monoid. data GlobalOptsMonoid = GlobalOptsMonoid { globalMonoidReExecVersion :: !(First String) -- ^ Expected re-exec in container version , globalMonoidDockerEntrypoint :: !(First DockerEntrypoint) -- ^ Data used when stack is acting as a Docker entrypoint (internal use only) , globalMonoidLogLevel :: !(First LogLevel) -- ^ Log level , globalMonoidConfigMonoid :: !ConfigMonoid -- ^ Config monoid, for passing into 'loadConfig' , globalMonoidResolver :: !(First AbstractResolver) -- ^ Resolver override , globalMonoidCompiler :: !(First CompilerVersion) -- ^ Compiler override , globalMonoidTerminal :: !(First Bool) -- ^ We're in a terminal? , globalMonoidStackYaml :: !(First FilePath) -- ^ Override project stack.yaml } deriving (Show, Generic) instance Monoid GlobalOptsMonoid where mempty = memptydefault mappend = mappenddefault -- | Either an actual resolver value, or an abstract description of one (e.g., -- latest nightly). data AbstractResolver = ARLatestNightly | ARLatestLTS | ARLatestLTSMajor !Int | ARResolver !Resolver | ARGlobal deriving Show -- | Default logging level should be something useful but not crazy. defaultLogLevel :: LogLevel defaultLogLevel = LevelInfo -- | A superset of 'Config' adding information on how to build code. The reason -- for this breakdown is because we will need some of the information from -- 'Config' in order to determine the values here. data BuildConfig = BuildConfig { bcConfig :: !Config , bcResolver :: !LoadedResolver -- ^ How we resolve which dependencies to install given a set of -- packages. , bcWantedMiniBuildPlan :: !MiniBuildPlan -- ^ Compiler version wanted for this build , bcPackageEntries :: ![PackageEntry] -- ^ Local packages , bcExtraDeps :: !(Map PackageName Version) -- ^ Extra dependencies specified in configuration. -- -- These dependencies will not be installed to a shared location, and -- will override packages provided by the resolver. , bcExtraPackageDBs :: ![Path Abs Dir] -- ^ Extra package databases , bcStackYaml :: !(Path Abs File) -- ^ Location of the stack.yaml file. -- -- Note: if the STACK_YAML environment variable is used, this may be -- different from bcRoot "stack.yaml" , bcFlags :: !PackageFlags -- ^ Per-package flag overrides , bcImplicitGlobal :: !Bool -- ^ Are we loading from the implicit global stack.yaml? This is useful -- for providing better error messages. , bcGHCVariant :: !GHCVariant -- ^ The variant of GHC used to select a GHC bindist. } -- | Directory containing the project's stack.yaml file bcRoot :: BuildConfig -> Path Abs Dir bcRoot = parent . bcStackYaml -- | @"'bcRoot'/.stack-work"@ bcWorkDir :: (MonadReader env m, HasConfig env) => BuildConfig -> m (Path Abs Dir) bcWorkDir bconfig = do workDir <- getWorkDir return (bcRoot bconfig workDir) bcWantedCompiler :: BuildConfig -> CompilerVersion bcWantedCompiler = mbpCompilerVersion . bcWantedMiniBuildPlan -- | Configuration after the environment has been setup. data EnvConfig = EnvConfig {envConfigBuildConfig :: !BuildConfig ,envConfigCabalVersion :: !Version ,envConfigCompilerVersion :: !CompilerVersion ,envConfigPackages :: !(Map (Path Abs Dir) TreatLikeExtraDep)} instance HasBuildConfig EnvConfig where getBuildConfig = envConfigBuildConfig instance HasConfig EnvConfig instance HasPlatform EnvConfig instance HasGHCVariant EnvConfig instance HasStackRoot EnvConfig class (HasBuildConfig r, HasGHCVariant r) => HasEnvConfig r where getEnvConfig :: r -> EnvConfig instance HasEnvConfig EnvConfig where getEnvConfig = id -- | Value returned by 'Stack.Config.loadConfig'. data LoadConfig m = LoadConfig { lcConfig :: !Config -- ^ Top-level Stack configuration. , lcLoadBuildConfig :: !(Maybe CompilerVersion -> m BuildConfig) -- ^ Action to load the remaining 'BuildConfig'. , lcProjectRoot :: !(Maybe (Path Abs Dir)) -- ^ The project root directory, if in a project. } data PackageEntry = PackageEntry { peExtraDep :: !TreatLikeExtraDep , peLocation :: !PackageLocation , peSubdirs :: ![FilePath] } deriving Show -- | Should a package be treated just like an extra-dep? -- -- 'True' means, it will only be built as a dependency -- for others, and its test suite/benchmarks will not be run. -- -- Useful modifying an upstream package, see: -- https://github.com/commercialhaskell/stack/issues/219 -- https://github.com/commercialhaskell/stack/issues/386 type TreatLikeExtraDep = Bool instance ToJSON PackageEntry where toJSON pe | not (peExtraDep pe) && null (peSubdirs pe) = toJSON $ peLocation pe toJSON pe = object [ "extra-dep" .= peExtraDep pe , "location" .= peLocation pe , "subdirs" .= peSubdirs pe ] instance FromJSON (WithJSONWarnings PackageEntry) where parseJSON (String t) = do WithJSONWarnings loc _ <- parseJSON $ String t return $ noJSONWarnings (PackageEntry { peExtraDep = False , peLocation = loc , peSubdirs = [] }) parseJSON v = withObjectWarnings "PackageEntry" (\o -> PackageEntry <$> o ..:? "extra-dep" ..!= False <*> jsonSubWarnings (o ..: "location") <*> o ..:? "subdirs" ..!= []) v data PackageLocation = PLFilePath FilePath -- ^ Note that we use @FilePath@ and not @Path@s. The goal is: first parse -- the value raw, and then use @canonicalizePath@ and @parseAbsDir@. | PLRemote Text RemotePackageType -- ^ URL and further details deriving Show data RemotePackageType = RPTHttp | RPTGit Text -- ^ Commit | RPTHg Text -- ^ Commit deriving Show instance ToJSON PackageLocation where toJSON (PLFilePath fp) = toJSON fp toJSON (PLRemote t RPTHttp) = toJSON t toJSON (PLRemote x (RPTGit y)) = toJSON $ T.unwords ["git", x, y] toJSON (PLRemote x (RPTHg y)) = toJSON $ T.unwords ["hg", x, y] instance FromJSON (WithJSONWarnings PackageLocation) where parseJSON v = (noJSONWarnings <$> withText "PackageLocation" (\t -> http t <|> file t) v) <|> git v <|> hg v where file t = pure $ PLFilePath $ T.unpack t http t = case parseUrl $ T.unpack t of Left _ -> mzero Right _ -> return $ PLRemote t RPTHttp git = withObjectWarnings "PackageGitLocation" $ \o -> PLRemote <$> o ..: "git" <*> (RPTGit <$> o ..: "commit") hg = withObjectWarnings "PackageHgLocation" $ \o -> PLRemote <$> o ..: "hg" <*> (RPTHg <$> o ..: "commit") -- | A project is a collection of packages. We can have multiple stack.yaml -- files, but only one of them may contain project information. data Project = Project { projectUserMsg :: !(Maybe String) -- ^ A warning message to display to the user when the auto generated -- config may have issues. , projectPackages :: ![PackageEntry] -- ^ Components of the package list , projectExtraDeps :: !(Map PackageName Version) -- ^ Components of the package list referring to package/version combos, -- see: https://github.com/fpco/stack/issues/41 , projectFlags :: !PackageFlags -- ^ Per-package flag overrides , projectResolver :: !Resolver -- ^ How we resolve which dependencies to use , projectCompiler :: !(Maybe CompilerVersion) -- ^ When specified, overrides which compiler to use , projectExtraPackageDBs :: ![FilePath] } deriving Show instance ToJSON Project where toJSON p = object $ (maybe id (\cv -> (("compiler" .= cv) :)) (projectCompiler p)) ((maybe id (\msg -> (("user-message" .= msg) :)) (projectUserMsg p)) [ "packages" .= projectPackages p , "extra-deps" .= map fromTuple (Map.toList $ projectExtraDeps p) , "flags" .= projectFlags p , "resolver" .= projectResolver p , "extra-package-dbs" .= projectExtraPackageDBs p ]) data IsLoaded = Loaded | NotLoaded type LoadedResolver = ResolverThat's 'Loaded type Resolver = ResolverThat's 'NotLoaded -- TODO: once GHC 8.0 is the lowest version we support, make these into -- actual haddock comments... -- | How we resolve which dependencies to install given a set of packages. data ResolverThat's (l :: IsLoaded) where -- Use an official snapshot from the Stackage project, either an LTS -- Haskell or Stackage Nightly. ResolverSnapshot :: !SnapName -> ResolverThat's l -- Require a specific compiler version, but otherwise provide no -- build plan. Intended for use cases where end user wishes to -- specify all upstream dependencies manually, such as using a -- dependency solver. ResolverCompiler :: !CompilerVersion -> ResolverThat's l -- A custom resolver based on the given name and URL. When a URL is -- provided, it file is to be completely immutable. Filepaths are -- always loaded. This constructor is used before the build-plan has -- been loaded, as we do not yet know the custom snapshot's hash. ResolverCustom :: !Text -> !Text -> ResolverThat's 'NotLoaded -- Like 'ResolverCustom', but after loading the build-plan, so we -- have a hash. This is necessary in order to identify the location -- files are stored for the resolver. ResolverCustomLoaded :: !Text -> !Text -> !SnapshotHash -> ResolverThat's 'Loaded deriving instance Show (ResolverThat's k) instance ToJSON (ResolverThat's k) where toJSON x = case x of ResolverSnapshot{} -> toJSON $ resolverName x ResolverCompiler{} -> toJSON $ resolverName x ResolverCustom n l -> handleCustom n l ResolverCustomLoaded n l _ -> handleCustom n l where handleCustom n l = object [ "name" .= n , "location" .= l ] instance FromJSON (WithJSONWarnings (ResolverThat's 'NotLoaded)) where -- Strange structuring is to give consistent error messages parseJSON v@(Object _) = withObjectWarnings "Resolver" (\o -> ResolverCustom <$> o ..: "name" <*> o ..: "location") v parseJSON (String t) = either (fail . show) return (noJSONWarnings <$> parseResolverText t) parseJSON _ = fail $ "Invalid Resolver, must be Object or String" -- | Convert a Resolver into its @Text@ representation, as will be used by -- directory names resolverDirName :: LoadedResolver -> Text resolverDirName (ResolverSnapshot name) = renderSnapName name resolverDirName (ResolverCompiler v) = compilerVersionText v resolverDirName (ResolverCustomLoaded name _ hash) = "custom-" <> name <> "-" <> decodeUtf8 (trimmedSnapshotHash hash) -- | Convert a Resolver into its @Text@ representation for human -- presentation. resolverName :: ResolverThat's l -> Text resolverName (ResolverSnapshot name) = renderSnapName name resolverName (ResolverCompiler v) = compilerVersionText v resolverName (ResolverCustom name _) = "custom-" <> name resolverName (ResolverCustomLoaded name _ _) = "custom-" <> name customResolverHash :: LoadedResolver-> Maybe SnapshotHash customResolverHash (ResolverCustomLoaded _ _ hash) = Just hash customResolverHash _ = Nothing -- | Try to parse a @Resolver@ from a @Text@. Won't work for complex resolvers (like custom). parseResolverText :: MonadThrow m => Text -> m Resolver parseResolverText t | Right x <- parseSnapName t = return $ ResolverSnapshot x | Just v <- parseCompilerVersion t = return $ ResolverCompiler v | otherwise = throwM $ ParseResolverException t toResolverNotLoaded :: LoadedResolver -> Resolver toResolverNotLoaded r = case r of ResolverSnapshot s -> ResolverSnapshot s ResolverCompiler v -> ResolverCompiler v ResolverCustomLoaded n l _ -> ResolverCustom n l -- | Class for environment values which have access to the stack root class HasStackRoot env where getStackRoot :: env -> Path Abs Dir default getStackRoot :: HasConfig env => env -> Path Abs Dir getStackRoot = configStackRoot . getConfig {-# INLINE getStackRoot #-} -- | Class for environment values which have a Platform class HasPlatform env where getPlatform :: env -> Platform default getPlatform :: HasConfig env => env -> Platform getPlatform = configPlatform . getConfig {-# INLINE getPlatform #-} getPlatformVariant :: env -> PlatformVariant default getPlatformVariant :: HasConfig env => env -> PlatformVariant getPlatformVariant = configPlatformVariant . getConfig {-# INLINE getPlatformVariant #-} instance HasPlatform (Platform,PlatformVariant) where getPlatform (p,_) = p getPlatformVariant (_,v) = v -- | Class for environment values which have a GHCVariant class HasGHCVariant env where getGHCVariant :: env -> GHCVariant default getGHCVariant :: HasBuildConfig env => env -> GHCVariant getGHCVariant = bcGHCVariant . getBuildConfig {-# INLINE getGHCVariant #-} instance HasGHCVariant GHCVariant where getGHCVariant = id -- | Class for environment values that can provide a 'Config'. class (HasStackRoot env, HasPlatform env) => HasConfig env where getConfig :: env -> Config default getConfig :: HasBuildConfig env => env -> Config getConfig = bcConfig . getBuildConfig {-# INLINE getConfig #-} instance HasStackRoot Config instance HasPlatform Config instance HasConfig Config where getConfig = id {-# INLINE getConfig #-} -- | Class for environment values that can provide a 'BuildConfig'. class HasConfig env => HasBuildConfig env where getBuildConfig :: env -> BuildConfig instance HasStackRoot BuildConfig instance HasPlatform BuildConfig instance HasGHCVariant BuildConfig instance HasConfig BuildConfig instance HasBuildConfig BuildConfig where getBuildConfig = id {-# INLINE getBuildConfig #-} -- An uninterpreted representation of configuration options. -- Configurations may be "cascaded" using mappend (left-biased). data ConfigMonoid = ConfigMonoid { configMonoidStackRoot :: !(First (Path Abs Dir)) -- ^ See: 'configStackRoot' , configMonoidWorkDir :: !(First FilePath) -- ^ See: 'configWorkDir'. , configMonoidBuildOpts :: !BuildOptsMonoid -- ^ build options. , configMonoidDockerOpts :: !DockerOptsMonoid -- ^ Docker options. , configMonoidNixOpts :: !NixOptsMonoid -- ^ Options for the execution environment (nix-shell or container) , configMonoidConnectionCount :: !(First Int) -- ^ See: 'configConnectionCount' , configMonoidHideTHLoading :: !(First Bool) -- ^ See: 'configHideTHLoading' , configMonoidLatestSnapshotUrl :: !(First Text) -- ^ Deprecated in favour of 'urlsMonoidLatestSnapshot' , configMonoidUrls :: !UrlsMonoid -- ^ See: 'configUrls , configMonoidPackageIndices :: !(First [PackageIndex]) -- ^ See: 'configPackageIndices' , configMonoidSystemGHC :: !(First Bool) -- ^ See: 'configSystemGHC' ,configMonoidInstallGHC :: !(First Bool) -- ^ See: 'configInstallGHC' ,configMonoidSkipGHCCheck :: !(First Bool) -- ^ See: 'configSkipGHCCheck' ,configMonoidSkipMsys :: !(First Bool) -- ^ See: 'configSkipMsys' ,configMonoidCompilerCheck :: !(First VersionCheck) -- ^ See: 'configCompilerCheck' ,configMonoidRequireStackVersion :: !IntersectingVersionRange -- ^ See: 'configRequireStackVersion' ,configMonoidOS :: !(First String) -- ^ Used for overriding the platform ,configMonoidArch :: !(First String) -- ^ Used for overriding the platform ,configMonoidGHCVariant :: !(First GHCVariant) -- ^ Used for overriding the GHC variant ,configMonoidJobs :: !(First Int) -- ^ See: 'configJobs' ,configMonoidExtraIncludeDirs :: !(Set Text) -- ^ See: 'configExtraIncludeDirs' ,configMonoidExtraLibDirs :: !(Set Text) -- ^ See: 'configExtraLibDirs' ,configMonoidConcurrentTests :: !(First Bool) -- ^ See: 'configConcurrentTests' ,configMonoidLocalBinPath :: !(First FilePath) -- ^ Used to override the binary installation dir ,configMonoidImageOpts :: !ImageOptsMonoid -- ^ Image creation options. ,configMonoidTemplateParameters :: !(Map Text Text) -- ^ Template parameters. ,configMonoidScmInit :: !(First SCM) -- ^ Initialize SCM (e.g. git init) when making new projects? ,configMonoidGhcOptions :: !GhcOptions -- ^ See 'configGhcOptions' ,configMonoidExtraPath :: ![Path Abs Dir] -- ^ Additional paths to search for executables in ,configMonoidSetupInfoLocations :: ![SetupInfoLocation] -- ^ Additional setup info (inline or remote) to use for installing tools ,configMonoidPvpBounds :: !(First PvpBounds) -- ^ See 'configPvpBounds' ,configMonoidModifyCodePage :: !(First Bool) -- ^ See 'configModifyCodePage' ,configMonoidExplicitSetupDeps :: !(Map (Maybe PackageName) Bool) -- ^ See 'configExplicitSetupDeps' ,configMonoidRebuildGhcOptions :: !(First Bool) -- ^ See 'configMonoidRebuildGhcOptions' ,configMonoidApplyGhcOptions :: !(First ApplyGhcOptions) -- ^ See 'configApplyGhcOptions' ,configMonoidAllowNewer :: !(First Bool) -- ^ See 'configMonoidAllowNewer' ,configMonoidDefaultTemplate :: !(First TemplateName) -- ^ The default template to use when none is specified. -- (If Nothing, the default default is used.) , configMonoidAllowDifferentUser :: !(First Bool) -- ^ Allow users other than the stack root owner to use the stack -- installation. } deriving (Show, Generic) instance Monoid ConfigMonoid where mempty = memptydefault mappend = mappenddefault instance FromJSON (WithJSONWarnings ConfigMonoid) where parseJSON = withObjectWarnings "ConfigMonoid" parseConfigMonoidJSON -- | Parse a partial configuration. Used both to parse both a standalone config -- file and a project file, so that a sub-parser is not required, which would interfere with -- warnings for missing fields. parseConfigMonoidJSON :: Object -> WarningParser ConfigMonoid parseConfigMonoidJSON obj = do -- Parsing 'stackRoot' from 'stackRoot'/config.yaml would be nonsensical let configMonoidStackRoot = First Nothing configMonoidWorkDir <- First <$> obj ..:? configMonoidWorkDirName configMonoidBuildOpts <- jsonSubWarnings (obj ..:? configMonoidBuildOptsName ..!= mempty) configMonoidDockerOpts <- jsonSubWarnings (obj ..:? configMonoidDockerOptsName ..!= mempty) configMonoidNixOpts <- jsonSubWarnings (obj ..:? configMonoidNixOptsName ..!= mempty) configMonoidConnectionCount <- First <$> obj ..:? configMonoidConnectionCountName configMonoidHideTHLoading <- First <$> obj ..:? configMonoidHideTHLoadingName configMonoidLatestSnapshotUrl <- First <$> obj ..:? configMonoidLatestSnapshotUrlName configMonoidUrls <- jsonSubWarnings (obj ..:? configMonoidUrlsName ..!= mempty) configMonoidPackageIndices <- First <$> jsonSubWarningsTT (obj ..:? configMonoidPackageIndicesName) configMonoidSystemGHC <- First <$> obj ..:? configMonoidSystemGHCName configMonoidInstallGHC <- First <$> obj ..:? configMonoidInstallGHCName configMonoidSkipGHCCheck <- First <$> obj ..:? configMonoidSkipGHCCheckName configMonoidSkipMsys <- First <$> obj ..:? configMonoidSkipMsysName configMonoidRequireStackVersion <- IntersectingVersionRange <$> unVersionRangeJSON <$> obj ..:? configMonoidRequireStackVersionName ..!= VersionRangeJSON anyVersion configMonoidOS <- First <$> obj ..:? configMonoidOSName configMonoidArch <- First <$> obj ..:? configMonoidArchName configMonoidGHCVariant <- First <$> obj ..:? configMonoidGHCVariantName configMonoidJobs <- First <$> obj ..:? configMonoidJobsName configMonoidExtraIncludeDirs <- obj ..:? configMonoidExtraIncludeDirsName ..!= Set.empty configMonoidExtraLibDirs <- obj ..:? configMonoidExtraLibDirsName ..!= Set.empty configMonoidConcurrentTests <- First <$> obj ..:? configMonoidConcurrentTestsName configMonoidLocalBinPath <- First <$> obj ..:? configMonoidLocalBinPathName configMonoidImageOpts <- jsonSubWarnings (obj ..:? configMonoidImageOptsName ..!= mempty) templates <- obj ..:? "templates" (configMonoidScmInit,configMonoidTemplateParameters) <- case templates of Nothing -> return (First Nothing,M.empty) Just tobj -> do scmInit <- tobj ..:? configMonoidScmInitName params <- tobj ..:? configMonoidTemplateParametersName return (First scmInit,fromMaybe M.empty params) configMonoidCompilerCheck <- First <$> obj ..:? configMonoidCompilerCheckName configMonoidGhcOptions <- obj ..:? configMonoidGhcOptionsName ..!= mempty extraPath <- obj ..:? configMonoidExtraPathName ..!= [] configMonoidExtraPath <- forM extraPath $ either (fail . show) return . parseAbsDir . T.unpack configMonoidSetupInfoLocations <- maybeToList <$> jsonSubWarningsT (obj ..:? configMonoidSetupInfoLocationsName) configMonoidPvpBounds <- First <$> obj ..:? configMonoidPvpBoundsName configMonoidModifyCodePage <- First <$> obj ..:? configMonoidModifyCodePageName configMonoidExplicitSetupDeps <- (obj ..:? configMonoidExplicitSetupDepsName ..!= mempty) >>= fmap Map.fromList . mapM handleExplicitSetupDep . Map.toList configMonoidRebuildGhcOptions <- First <$> obj ..:? configMonoidRebuildGhcOptionsName configMonoidApplyGhcOptions <- First <$> obj ..:? configMonoidApplyGhcOptionsName configMonoidAllowNewer <- First <$> obj ..:? configMonoidAllowNewerName configMonoidDefaultTemplate <- First <$> obj ..:? configMonoidDefaultTemplateName configMonoidAllowDifferentUser <- First <$> obj ..:? configMonoidAllowDifferentUserName return ConfigMonoid {..} where handleExplicitSetupDep :: Monad m => (Text, Bool) -> m (Maybe PackageName, Bool) handleExplicitSetupDep (name', b) = do name <- if name' == "*" then return Nothing else case parsePackageNameFromString $ T.unpack name' of Left e -> fail $ show e Right x -> return $ Just x return (name, b) configMonoidWorkDirName :: Text configMonoidWorkDirName = "work-dir" configMonoidBuildOptsName :: Text configMonoidBuildOptsName = "build" configMonoidDockerOptsName :: Text configMonoidDockerOptsName = "docker" configMonoidNixOptsName :: Text configMonoidNixOptsName = "nix" configMonoidConnectionCountName :: Text configMonoidConnectionCountName = "connection-count" configMonoidHideTHLoadingName :: Text configMonoidHideTHLoadingName = "hide-th-loading" configMonoidLatestSnapshotUrlName :: Text configMonoidLatestSnapshotUrlName = "latest-snapshot-url" configMonoidUrlsName :: Text configMonoidUrlsName = "urls" configMonoidPackageIndicesName :: Text configMonoidPackageIndicesName = "package-indices" configMonoidSystemGHCName :: Text configMonoidSystemGHCName = "system-ghc" configMonoidInstallGHCName :: Text configMonoidInstallGHCName = "install-ghc" configMonoidSkipGHCCheckName :: Text configMonoidSkipGHCCheckName = "skip-ghc-check" configMonoidSkipMsysName :: Text configMonoidSkipMsysName = "skip-msys" configMonoidRequireStackVersionName :: Text configMonoidRequireStackVersionName = "require-stack-version" configMonoidOSName :: Text configMonoidOSName = "os" configMonoidArchName :: Text configMonoidArchName = "arch" configMonoidGHCVariantName :: Text configMonoidGHCVariantName = "ghc-variant" configMonoidJobsName :: Text configMonoidJobsName = "jobs" configMonoidExtraIncludeDirsName :: Text configMonoidExtraIncludeDirsName = "extra-include-dirs" configMonoidExtraLibDirsName :: Text configMonoidExtraLibDirsName = "extra-lib-dirs" configMonoidConcurrentTestsName :: Text configMonoidConcurrentTestsName = "concurrent-tests" configMonoidLocalBinPathName :: Text configMonoidLocalBinPathName = "local-bin-path" configMonoidImageOptsName :: Text configMonoidImageOptsName = "image" configMonoidScmInitName :: Text configMonoidScmInitName = "scm-init" configMonoidTemplateParametersName :: Text configMonoidTemplateParametersName = "params" configMonoidCompilerCheckName :: Text configMonoidCompilerCheckName = "compiler-check" configMonoidGhcOptionsName :: Text configMonoidGhcOptionsName = "ghc-options" configMonoidExtraPathName :: Text configMonoidExtraPathName = "extra-path" configMonoidSetupInfoLocationsName :: Text configMonoidSetupInfoLocationsName = "setup-info" configMonoidPvpBoundsName :: Text configMonoidPvpBoundsName = "pvp-bounds" configMonoidModifyCodePageName :: Text configMonoidModifyCodePageName = "modify-code-page" configMonoidExplicitSetupDepsName :: Text configMonoidExplicitSetupDepsName = "explicit-setup-deps" configMonoidRebuildGhcOptionsName :: Text configMonoidRebuildGhcOptionsName = "rebuild-ghc-options" configMonoidApplyGhcOptionsName :: Text configMonoidApplyGhcOptionsName = "apply-ghc-options" configMonoidAllowNewerName :: Text configMonoidAllowNewerName = "allow-newer" configMonoidDefaultTemplateName :: Text configMonoidDefaultTemplateName = "default-template" configMonoidAllowDifferentUserName :: Text configMonoidAllowDifferentUserName = "allow-different-user" data ConfigException = ParseConfigFileException (Path Abs File) ParseException | ParseCustomSnapshotException Text ParseException | ParseResolverException Text | NoProjectConfigFound (Path Abs Dir) (Maybe Text) | UnexpectedArchiveContents [Path Abs Dir] [Path Abs File] | UnableToExtractArchive Text (Path Abs File) | BadStackVersionException VersionRange | NoMatchingSnapshot WhichSolverCmd (NonEmpty SnapName) | forall l. ResolverMismatch WhichSolverCmd (ResolverThat's l) String | ResolverPartial WhichSolverCmd Resolver String | NoSuchDirectory FilePath | ParseGHCVariantException String | BadStackRoot (Path Abs Dir) | Won'tCreateStackRootInDirectoryOwnedByDifferentUser (Path Abs Dir) (Path Abs Dir) -- ^ @$STACK_ROOT@, parent dir | UserDoesn'tOwnDirectory (Path Abs Dir) deriving Typeable instance Show ConfigException where show (ParseConfigFileException configFile exception) = concat [ "Could not parse '" , toFilePath configFile , "':\n" , show exception , "\nSee http://docs.haskellstack.org/en/stable/yaml_configuration/." ] show (ParseCustomSnapshotException url exception) = concat [ "Could not parse '" , T.unpack url , "':\n" , show exception -- FIXME: Link to docs about custom snapshots -- , "\nSee http://docs.haskellstack.org/en/stable/yaml_configuration/." ] show (ParseResolverException t) = concat [ "Invalid resolver value: " , T.unpack t , ". Possible valid values include lts-2.12, nightly-YYYY-MM-DD, ghc-7.10.2, and ghcjs-0.1.0_ghc-7.10.2. " , "See https://www.stackage.org/snapshots for a complete list." ] show (NoProjectConfigFound dir mcmd) = concat [ "Unable to find a stack.yaml file in the current directory (" , toFilePath dir , ") or its ancestors" , case mcmd of Nothing -> "" Just cmd -> "\nRecommended action: stack " ++ T.unpack cmd ] show (UnexpectedArchiveContents dirs files) = concat [ "When unpacking an archive specified in your stack.yaml file, " , "did not find expected contents. Expected: a single directory. Found: " , show ( map (toFilePath . dirname) dirs , map (toFilePath . filename) files ) ] show (UnableToExtractArchive url file) = concat [ "Archive extraction failed. We support tarballs and zip, couldn't handle the following URL, " , T.unpack url, " downloaded to the file ", toFilePath $ filename file ] show (BadStackVersionException requiredRange) = concat [ "The version of stack you are using (" , show (fromCabalVersion Meta.version) , ") is outside the required\n" ,"version range specified in stack.yaml (" , T.unpack (versionRangeText requiredRange) , ")." ] show (NoMatchingSnapshot whichCmd names) = concat $ [ "None of the following snapshots provides a compiler matching " , "your package(s):\n" , unlines $ map (\name -> " - " <> T.unpack (renderSnapName name)) (NonEmpty.toList names) , showOptions whichCmd ] show (ResolverMismatch whichCmd resolver errDesc) = concat [ "Resolver '" , T.unpack (resolverName resolver) , "' does not have a matching compiler to build some or all of your " , "package(s).\n" , errDesc , showOptions whichCmd ] show (ResolverPartial whichCmd resolver errDesc) = concat [ "Resolver '" , T.unpack (resolverName resolver) , "' does not have all the packages to match your requirements.\n" , unlines $ fmap (" " <>) (lines errDesc) , showOptions whichCmd ] show (NoSuchDirectory dir) = concat ["No directory could be located matching the supplied path: " ,dir ] show (ParseGHCVariantException v) = concat [ "Invalid ghc-variant value: " , v ] show (BadStackRoot stackRoot) = concat [ "Invalid stack root: '" , toFilePath stackRoot , "'. Please provide a valid absolute path." ] show (Won'tCreateStackRootInDirectoryOwnedByDifferentUser envStackRoot parentDir) = concat [ "Preventing creation of stack root '" , toFilePath envStackRoot , "'. Parent directory '" , toFilePath parentDir , "' is owned by someone else." ] show (UserDoesn'tOwnDirectory dir) = concat [ "You are not the owner of '" , toFilePath dir , "'. Aborting to protect file permissions." , "\nRetry with '--" , T.unpack configMonoidAllowDifferentUserName , "' to disable this precaution." ] instance Exception ConfigException showOptions :: WhichSolverCmd -> String showOptions whichCmd = unlines $ ["\nThis may be resolved by:"] ++ options where options = case whichCmd of IsSolverCmd -> [useResolver] IsInitCmd -> both IsNewCmd -> both both = [omitPackages, useResolver] omitPackages = " - Using '--omit-packages to exclude mismatching package(s)." useResolver = " - Using '--resolver' to specify a matching snapshot/resolver" data WhichSolverCmd = IsInitCmd | IsSolverCmd | IsNewCmd -- | Helper function to ask the environment and apply getConfig askConfig :: (MonadReader env m, HasConfig env) => m Config askConfig = liftM getConfig ask -- | Get the URL to request the information on the latest snapshots askLatestSnapshotUrl :: (MonadReader env m, HasConfig env) => m Text askLatestSnapshotUrl = asks (urlsLatestSnapshot . configUrls . getConfig) -- | Root for a specific package index configPackageIndexRoot :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> m (Path Abs Dir) configPackageIndexRoot (IndexName name) = do config <- asks getConfig dir <- parseRelDir $ S8.unpack name return (configStackRoot config $(mkRelDir "indices") dir) -- | Git repo directory for a specific package index, returns 'Nothing' if not -- a Git repo configPackageIndexRepo :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> m (Maybe (Path Abs Dir)) configPackageIndexRepo name = do indices <- asks $ configPackageIndices . getConfig case filter (\p -> indexName p == name) indices of [index] -> do let murl = case indexLocation index of ILGit x -> Just x ILHttp _ -> Nothing ILGitHttp x _ -> Just x case murl of Nothing -> return Nothing Just url -> do sDir <- configPackageIndexRoot name repoName <- parseRelDir $ takeBaseName $ T.unpack url let suDir = sDir $(mkRelDir "git-update") return $ Just $ suDir repoName _ -> assert False $ return Nothing -- | Location of the 00-index.cache file configPackageIndexCache :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> m (Path Abs File) configPackageIndexCache = liftM ( $(mkRelFile "00-index.cache")) . configPackageIndexRoot -- | Location of the 00-index.tar file configPackageIndex :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> m (Path Abs File) configPackageIndex = liftM ( $(mkRelFile "00-index.tar")) . configPackageIndexRoot -- | Location of the 00-index.tar.gz file configPackageIndexGz :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> m (Path Abs File) configPackageIndexGz = liftM ( $(mkRelFile "00-index.tar.gz")) . configPackageIndexRoot -- | Location of a package tarball configPackageTarball :: (MonadReader env m, HasConfig env, MonadThrow m) => IndexName -> PackageIdentifier -> m (Path Abs File) configPackageTarball iname ident = do root <- configPackageIndexRoot iname name <- parseRelDir $ packageNameString $ packageIdentifierName ident ver <- parseRelDir $ versionString $ packageIdentifierVersion ident base <- parseRelFile $ packageIdentifierString ident ++ ".tar.gz" return (root $(mkRelDir "packages") name ver base) -- | @".stack-work"@ getWorkDir :: (MonadReader env m, HasConfig env) => m (Path Rel Dir) getWorkDir = configWorkDir `liftM` asks getConfig -- | Per-project work dir getProjectWorkDir :: (HasBuildConfig env, MonadReader env m) => m (Path Abs Dir) getProjectWorkDir = do bc <- asks getBuildConfig workDir <- getWorkDir return (bcRoot bc workDir) -- | File containing the installed cache, see "Stack.PackageDump" configInstalledCache :: (HasBuildConfig env, MonadReader env m) => m (Path Abs File) configInstalledCache = liftM ( $(mkRelFile "installed-cache.bin")) getProjectWorkDir -- | Relative directory for the platform identifier platformOnlyRelDir :: (MonadReader env m, HasPlatform env, MonadThrow m) => m (Path Rel Dir) platformOnlyRelDir = do platform <- asks getPlatform platformVariant <- asks getPlatformVariant parseRelDir (Distribution.Text.display platform ++ platformVariantSuffix platformVariant) -- | Directory containing snapshots snapshotsDir :: (MonadReader env m, HasConfig env, HasGHCVariant env, MonadThrow m) => m (Path Abs Dir) snapshotsDir = do config <- asks getConfig platform <- platformGhcRelDir return $ configStackRoot config $(mkRelDir "snapshots") platform -- | Installation root for dependencies installationRootDeps :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir) installationRootDeps = do config <- asks getConfig -- TODO: also useShaPathOnWindows here, once #1173 is resolved. psc <- platformSnapAndCompilerRel return $ configStackRoot config $(mkRelDir "snapshots") psc -- | Installation root for locals installationRootLocal :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir) installationRootLocal = do bc <- asks getBuildConfig psc <- useShaPathOnWindows =<< platformSnapAndCompilerRel return $ getProjectWorkDir bc $(mkRelDir "install") psc -- | Path for platform followed by snapshot name followed by compiler -- name. platformSnapAndCompilerRel :: (MonadReader env m, HasEnvConfig env, MonadThrow m) => m (Path Rel Dir) platformSnapAndCompilerRel = do bc <- asks getBuildConfig platform <- platformGhcRelDir name <- parseRelDir $ T.unpack $ resolverDirName $ bcResolver bc ghc <- compilerVersionDir useShaPathOnWindows (platform name ghc) -- | Relative directory for the platform identifier platformGhcRelDir :: (MonadReader env m, HasPlatform env, HasGHCVariant env, MonadThrow m) => m (Path Rel Dir) platformGhcRelDir = do platform <- asks getPlatform platformVariant <- asks getPlatformVariant ghcVariant <- asks getGHCVariant parseRelDir (mconcat [ Distribution.Text.display platform , platformVariantSuffix platformVariant , ghcVariantSuffix ghcVariant ]) -- | This is an attempt to shorten stack paths on Windows to decrease our -- chances of hitting 260 symbol path limit. The idea is to calculate -- SHA1 hash of the path used on other architectures, encode with base -- 16 and take first 8 symbols of it. useShaPathOnWindows :: MonadThrow m => Path Rel Dir -> m (Path Rel Dir) useShaPathOnWindows = #ifdef mingw32_HOST_OS parseRelDir . S8.unpack . S8.take 8 . B16.encode . SHA1.hash . encodeUtf8 . T.pack . toFilePath #else return #endif compilerVersionDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Rel Dir) compilerVersionDir = do compilerVersion <- asks (envConfigCompilerVersion . getEnvConfig) parseRelDir $ case compilerVersion of GhcVersion version -> versionString version GhcjsVersion {} -> compilerVersionString compilerVersion -- | Package database for installing dependencies into packageDatabaseDeps :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir) packageDatabaseDeps = do root <- installationRootDeps return $ root $(mkRelDir "pkgdb") -- | Package database for installing local packages into packageDatabaseLocal :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir) packageDatabaseLocal = do root <- installationRootLocal return $ root $(mkRelDir "pkgdb") -- | Extra package databases packageDatabaseExtra :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m [Path Abs Dir] packageDatabaseExtra = do bc <- asks getBuildConfig return $ bcExtraPackageDBs bc -- | Directory for holding flag cache information flagCacheLocal :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir) flagCacheLocal = do root <- installationRootLocal return $ root $(mkRelDir "flag-cache") -- | Where to store mini build plan caches configMiniBuildPlanCache :: (MonadThrow m, MonadReader env m, HasConfig env, HasGHCVariant env) => SnapName -> m (Path Abs File) configMiniBuildPlanCache name = do root <- asks getStackRoot platform <- platformGhcRelDir file <- parseRelFile $ T.unpack (renderSnapName name) ++ ".cache" -- Yes, cached plans differ based on platform return (root $(mkRelDir "build-plan-cache") platform file) -- | Suffix applied to an installation root to get the bin dir bindirSuffix :: Path Rel Dir bindirSuffix = $(mkRelDir "bin") -- | Suffix applied to an installation root to get the doc dir docDirSuffix :: Path Rel Dir docDirSuffix = $(mkRelDir "doc") -- | Where HPC reports and tix files get stored. hpcReportDir :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Path Abs Dir) hpcReportDir = do root <- installationRootLocal return $ root $(mkRelDir "hpc") -- | Get the extra bin directories (for the PATH). Puts more local first -- -- Bool indicates whether or not to include the locals extraBinDirs :: (MonadThrow m, MonadReader env m, HasEnvConfig env) => m (Bool -> [Path Abs Dir]) extraBinDirs = do deps <- installationRootDeps local <- installationRootLocal return $ \locals -> if locals then [local bindirSuffix, deps bindirSuffix] else [deps bindirSuffix] -- | Get the minimal environment override, useful for just calling external -- processes like git or ghc getMinimalEnvOverride :: (MonadReader env m, HasConfig env, MonadIO m) => m EnvOverride getMinimalEnvOverride = do config <- asks getConfig liftIO $ configEnvOverride config minimalEnvSettings minimalEnvSettings :: EnvSettings minimalEnvSettings = EnvSettings { esIncludeLocals = False , esIncludeGhcPackagePath = False , esStackExe = False , esLocaleUtf8 = False } getWhichCompiler :: (MonadReader env m, HasEnvConfig env) => m WhichCompiler getWhichCompiler = asks (whichCompiler . envConfigCompilerVersion . getEnvConfig) -- | Get the path for the given compiler ignoring any local binaries. -- -- https://github.com/commercialhaskell/stack/issues/1052 getCompilerPath :: (MonadIO m, MonadThrow m, MonadReader env m, HasConfig env) => WhichCompiler -> m (Path Abs File) getCompilerPath wc = do config <- asks getConfig eoWithoutLocals <- liftIO $ configEnvOverride config minimalEnvSettings { esLocaleUtf8 = True } join (findExecutable eoWithoutLocals (compilerExeName wc)) data ProjectAndConfigMonoid = ProjectAndConfigMonoid !Project !ConfigMonoid instance FromJSON (WithJSONWarnings ProjectAndConfigMonoid) where parseJSON = withObjectWarnings "ProjectAndConfigMonoid" $ \o -> do dirs <- jsonSubWarningsTT (o ..:? "packages") ..!= [packageEntryCurrDir] extraDeps' <- o ..:? "extra-deps" ..!= [] extraDeps <- case partitionEithers $ goDeps extraDeps' of ([], x) -> return $ Map.fromList x (errs, _) -> fail $ unlines errs flags <- o ..:? "flags" ..!= mempty resolver <- jsonSubWarnings (o ..: "resolver") compiler <- o ..:? "compiler" msg <- o ..:? "user-message" config <- parseConfigMonoidJSON o extraPackageDBs <- o ..:? "extra-package-dbs" ..!= [] let project = Project { projectUserMsg = msg , projectPackages = dirs , projectExtraDeps = extraDeps , projectFlags = flags , projectResolver = resolver , projectCompiler = compiler , projectExtraPackageDBs = extraPackageDBs } return $ ProjectAndConfigMonoid project config where goDeps = map toSingle . Map.toList . Map.unionsWith Set.union . map toMap where toMap i = Map.singleton (packageIdentifierName i) (Set.singleton (packageIdentifierVersion i)) toSingle (k, s) = case Set.toList s of [x] -> Right (k, x) xs -> Left $ concat [ "Multiple versions for package " , packageNameString k , ": " , unwords $ map versionString xs ] -- | A PackageEntry for the current directory, used as a default packageEntryCurrDir :: PackageEntry packageEntryCurrDir = PackageEntry { peExtraDep = False , peLocation = PLFilePath "." , peSubdirs = [] } -- | A software control system. data SCM = Git deriving (Show) instance FromJSON SCM where parseJSON v = do s <- parseJSON v case s of "git" -> return Git _ -> fail ("Unknown or unsupported SCM: " <> s) instance ToJSON SCM where toJSON Git = toJSON ("git" :: Text) -- | A variant of the platform, used to differentiate Docker builds from host data PlatformVariant = PlatformVariantNone | PlatformVariant String -- | Render a platform variant to a String suffix. platformVariantSuffix :: PlatformVariant -> String platformVariantSuffix PlatformVariantNone = "" platformVariantSuffix (PlatformVariant v) = "-" ++ v -- | Specialized bariant of GHC (e.g. libgmp4 or integer-simple) data GHCVariant = GHCStandard -- ^ Standard bindist | GHCGMP4 -- ^ Bindist that supports libgmp4 (centos66) | GHCArch -- ^ Bindist built on Arch Linux (bleeding-edge) | GHCIntegerSimple -- ^ Bindist that uses integer-simple | GHCCustom String -- ^ Other bindists deriving (Show) instance FromJSON GHCVariant where -- Strange structuring is to give consistent error messages parseJSON = withText "GHCVariant" (either (fail . show) return . parseGHCVariant . T.unpack) -- | Render a GHC variant to a String. ghcVariantName :: GHCVariant -> String ghcVariantName GHCStandard = "standard" ghcVariantName GHCGMP4 = "gmp4" ghcVariantName GHCArch = "arch" ghcVariantName GHCIntegerSimple = "integersimple" ghcVariantName (GHCCustom name) = "custom-" ++ name -- | Render a GHC variant to a String suffix. ghcVariantSuffix :: GHCVariant -> String ghcVariantSuffix GHCStandard = "" ghcVariantSuffix v = "-" ++ ghcVariantName v -- | Parse GHC variant from a String. parseGHCVariant :: (MonadThrow m) => String -> m GHCVariant parseGHCVariant s = case stripPrefix "custom-" s of Just name -> return (GHCCustom name) Nothing | s == "" -> return GHCStandard | s == "standard" -> return GHCStandard | s == "gmp4" -> return GHCGMP4 | s == "arch" -> return GHCArch | s == "integersimple" -> return GHCIntegerSimple | otherwise -> return (GHCCustom s) -- | Information for a file to download. data DownloadInfo = DownloadInfo { downloadInfoUrl :: Text , downloadInfoContentLength :: Maybe Int , downloadInfoSha1 :: Maybe ByteString } deriving (Show) instance FromJSON (WithJSONWarnings DownloadInfo) where parseJSON = withObjectWarnings "DownloadInfo" parseDownloadInfoFromObject -- | Parse JSON in existing object for 'DownloadInfo' parseDownloadInfoFromObject :: Object -> WarningParser DownloadInfo parseDownloadInfoFromObject o = do url <- o ..: "url" contentLength <- o ..:? "content-length" sha1TextMay <- o ..:? "sha1" return DownloadInfo { downloadInfoUrl = url , downloadInfoContentLength = contentLength , downloadInfoSha1 = fmap encodeUtf8 sha1TextMay } data VersionedDownloadInfo = VersionedDownloadInfo { vdiVersion :: Version , vdiDownloadInfo :: DownloadInfo } deriving Show instance FromJSON (WithJSONWarnings VersionedDownloadInfo) where parseJSON = withObjectWarnings "VersionedDownloadInfo" $ \o -> do version <- o ..: "version" downloadInfo <- parseDownloadInfoFromObject o return VersionedDownloadInfo { vdiVersion = version , vdiDownloadInfo = downloadInfo } data SetupInfo = SetupInfo { siSevenzExe :: Maybe DownloadInfo , siSevenzDll :: Maybe DownloadInfo , siMsys2 :: Map Text VersionedDownloadInfo , siGHCs :: Map Text (Map Version DownloadInfo) , siGHCJSs :: Map Text (Map CompilerVersion DownloadInfo) , siStack :: Map Text (Map Version DownloadInfo) } deriving Show instance FromJSON (WithJSONWarnings SetupInfo) where parseJSON = withObjectWarnings "SetupInfo" $ \o -> do siSevenzExe <- jsonSubWarningsT (o ..:? "sevenzexe-info") siSevenzDll <- jsonSubWarningsT (o ..:? "sevenzdll-info") siMsys2 <- jsonSubWarningsT (o ..:? "msys2" ..!= mempty) siGHCs <- jsonSubWarningsTT (o ..:? "ghc" ..!= mempty) siGHCJSs <- jsonSubWarningsTT (o ..:? "ghcjs" ..!= mempty) siStack <- jsonSubWarningsTT (o ..:? "stack" ..!= mempty) return SetupInfo {..} -- | For @siGHCs@ and @siGHCJSs@ fields maps are deeply merged. -- For all fields the values from the last @SetupInfo@ win. instance Monoid SetupInfo where mempty = SetupInfo { siSevenzExe = Nothing , siSevenzDll = Nothing , siMsys2 = Map.empty , siGHCs = Map.empty , siGHCJSs = Map.empty , siStack = Map.empty } mappend l r = SetupInfo { siSevenzExe = siSevenzExe r <|> siSevenzExe l , siSevenzDll = siSevenzDll r <|> siSevenzDll l , siMsys2 = siMsys2 r <> siMsys2 l , siGHCs = Map.unionWith (<>) (siGHCs r) (siGHCs l) , siGHCJSs = Map.unionWith (<>) (siGHCJSs r) (siGHCJSs l) , siStack = Map.unionWith (<>) (siStack l) (siStack r) } -- | Remote or inline 'SetupInfo' data SetupInfoLocation = SetupInfoFileOrURL String | SetupInfoInline SetupInfo deriving (Show) instance FromJSON (WithJSONWarnings SetupInfoLocation) where parseJSON v = (noJSONWarnings <$> withText "SetupInfoFileOrURL" (pure . SetupInfoFileOrURL . T.unpack) v) <|> inline where inline = do WithJSONWarnings si w <- parseJSON v return $ WithJSONWarnings (SetupInfoInline si) w -- | How PVP bounds should be added to .cabal files data PvpBounds = PvpBoundsNone | PvpBoundsUpper | PvpBoundsLower | PvpBoundsBoth deriving (Show, Read, Eq, Typeable, Ord, Enum, Bounded) pvpBoundsText :: PvpBounds -> Text pvpBoundsText PvpBoundsNone = "none" pvpBoundsText PvpBoundsUpper = "upper" pvpBoundsText PvpBoundsLower = "lower" pvpBoundsText PvpBoundsBoth = "both" parsePvpBounds :: Text -> Either String PvpBounds parsePvpBounds t = case Map.lookup t m of Nothing -> Left $ "Invalid PVP bounds: " ++ T.unpack t Just x -> Right x where m = Map.fromList $ map (pvpBoundsText &&& id) [minBound..maxBound] instance ToJSON PvpBounds where toJSON = toJSON . pvpBoundsText instance FromJSON PvpBounds where parseJSON = withText "PvpBounds" (either fail return . parsePvpBounds) -- | Provide an explicit list of package dependencies when running a custom Setup.hs explicitSetupDeps :: (MonadReader env m, HasConfig env) => PackageName -> m Bool explicitSetupDeps name = do m <- asks $ configExplicitSetupDeps . getConfig return $ -- Yes there are far cleverer ways to write this. I honestly consider -- the explicit pattern matching much easier to parse at a glance. case Map.lookup (Just name) m of Just b -> b Nothing -> case Map.lookup Nothing m of Just b -> b Nothing -> False -- default value -- | Data passed into Docker container for the Docker entrypoint's use data DockerEntrypoint = DockerEntrypoint { deUser :: !(Maybe DockerUser) -- ^ UID/GID/etc of host user, if we wish to perform UID/GID switch in container } deriving (Read,Show) -- | Docker host user info data DockerUser = DockerUser { duUid :: UserID -- ^ uid , duGid :: GroupID -- ^ gid , duGroups :: [GroupID] -- ^ Supplemantal groups , duUmask :: FileMode -- ^ File creation mask } } deriving (Read,Show) -- TODO: See section of -- https://github.com/commercialhaskell/stack/issues/1265 about -- rationalizing the config. It would also be nice to share more code. -- For now it's more convenient just to extend this type. However, it's -- unpleasant that it has overlap with both 'Project' and 'Config'. data CustomSnapshot = CustomSnapshot { csCompilerVersion :: !(Maybe CompilerVersion) , csPackages :: !(Set PackageIdentifier) , csDropPackages :: !(Set PackageName) , csFlags :: !PackageFlags , csGhcOptions :: !GhcOptions } instance FromJSON (WithJSONWarnings (CustomSnapshot, Maybe Resolver)) where parseJSON = withObjectWarnings "CustomSnapshot" $ \o -> (,) <$> (CustomSnapshot <$> o ..:? "compiler" <*> o ..:? "packages" ..!= mempty <*> o ..:? "drop-packages" ..!= mempty <*> o ..:? "flags" ..!= mempty <*> o ..:? configMonoidGhcOptionsName ..!= mempty) <*> jsonSubWarningsT (o ..:? "resolver") newtype GhcOptions = GhcOptions { unGhcOptions :: Map (Maybe PackageName) [Text] } deriving Show instance FromJSON GhcOptions where parseJSON val = do ghcOptions <- parseJSON val fmap (GhcOptions . Map.fromList) $ mapM handleGhcOptions $ Map.toList ghcOptions where handleGhcOptions :: Monad m => (Text, Text) -> m (Maybe PackageName, [Text]) handleGhcOptions (name', vals') = do name <- if name' == "*" then return Nothing else case parsePackageNameFromString $ T.unpack name' of Left e -> fail $ show e Right x -> return $ Just x case parseArgs Escaping vals' of Left e -> fail e Right vals -> return (name, map T.pack vals) instance Monoid GhcOptions where mempty = GhcOptions mempty -- FIXME: Should GhcOptions really monoid like this? Keeping it this -- way preserves the behavior of the ConfigMonoid. However, this -- means there isn't the ability to fully override snapshot -- ghc-options in the same way there is for flags. Do we want to -- change the semantics here? (particularly for extensible -- snapshots) mappend (GhcOptions l) (GhcOptions r) = GhcOptions (Map.unionWith (++) l r) ghcOptionsFor :: PackageName -> GhcOptions -> [Text] ghcOptionsFor name (GhcOptions mp) = M.findWithDefault [] Nothing mp ++ M.findWithDefault [] (Just name) mp newtype PackageFlags = PackageFlags { unPackageFlags :: Map PackageName (Map FlagName Bool) } deriving Show instance FromJSON PackageFlags where parseJSON val = PackageFlags <$> parseJSON val instance ToJSON PackageFlags where toJSON = toJSON . unPackageFlags instance Monoid PackageFlags where mempty = PackageFlags mempty mappend (PackageFlags l) (PackageFlags r) = PackageFlags (Map.unionWith Map.union l r) stack-1.1.2/src/Stack/Types/Config/Build.hs0000644000000000000000000003046312717707441016566 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Configuration options for building. module Stack.Types.Config.Build ( BuildOpts(..) , BuildCommand(..) , defaultBuildOpts , defaultBuildOptsCLI , BuildOptsCLI(..) , BuildOptsMonoid(..) , TestOpts(..) , defaultTestOpts , TestOptsMonoid(..) , HaddockOpts(..) , defaultHaddockOpts , HaddockOptsMonoid(..) , BenchmarkOpts(..) , defaultBenchmarkOpts , BenchmarkOptsMonoid(..) , FileWatchOpts(..) , BuildSubset(..) ) where import Control.Applicative import Data.Aeson.Extended import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Monoid import Data.Text (Text) import GHC.Generics (Generic) import Generics.Deriving.Monoid (memptydefault, mappenddefault) import Prelude -- Fix AMP warning import Stack.Types.FlagName import Stack.Types.PackageName -- | Build options that is interpreted by the build command. -- This is built up from BuildOptsCLI and BuildOptsMonoid data BuildOpts = BuildOpts {boptsLibProfile :: !Bool ,boptsExeProfile :: !Bool ,boptsHaddock :: !Bool -- ^ Build haddocks? ,boptsHaddockOpts :: !HaddockOpts -- ^ Options to pass to haddock ,boptsOpenHaddocks :: !Bool -- ^ Open haddocks in the browser? ,boptsHaddockDeps :: !(Maybe Bool) -- ^ Build haddocks for dependencies? ,boptsInstallExes :: !Bool -- ^ Install executables to user path after building? ,boptsPreFetch :: !Bool -- ^ Fetch all packages immediately -- ^ Watch files for changes and automatically rebuild ,boptsKeepGoing :: !(Maybe Bool) -- ^ Keep building/running after failure ,boptsForceDirty :: !Bool -- ^ Force treating all local packages as having dirty files ,boptsTests :: !Bool -- ^ Turn on tests for local targets ,boptsTestOpts :: !TestOpts -- ^ Additional test arguments ,boptsBenchmarks :: !Bool -- ^ Turn on benchmarks for local targets ,boptsBenchmarkOpts :: !BenchmarkOpts -- ^ Additional test arguments -- ^ Commands (with arguments) to run after a successful build -- ^ Only perform the configure step when building ,boptsReconfigure :: !Bool -- ^ Perform the configure step even if already configured ,boptsCabalVerbose :: !Bool -- ^ Ask Cabal to be verbose in its builds ,boptsSplitObjs :: !Bool -- ^ Whether to enable split-objs. } deriving (Show) defaultBuildOpts :: BuildOpts defaultBuildOpts = BuildOpts { boptsLibProfile = False , boptsExeProfile = False , boptsHaddock = False , boptsHaddockOpts = defaultHaddockOpts , boptsOpenHaddocks = False , boptsHaddockDeps = Nothing , boptsInstallExes = False , boptsPreFetch = False , boptsKeepGoing = Nothing , boptsForceDirty = False , boptsTests = False , boptsTestOpts = defaultTestOpts , boptsBenchmarks = False , boptsBenchmarkOpts = defaultBenchmarkOpts , boptsReconfigure = False , boptsCabalVerbose = False , boptsSplitObjs = False } defaultBuildOptsCLI ::BuildOptsCLI defaultBuildOptsCLI = BuildOptsCLI { boptsCLITargets = [] , boptsCLIDryrun = False , boptsCLIFlags = Map.empty , boptsCLIGhcOptions = [] , boptsCLIBuildSubset = BSAll , boptsCLIFileWatch = NoFileWatch , boptsCLIExec = [] , boptsCLIOnlyConfigure = False , boptsCLICommand = Build } -- | Build options that may only be specified from the CLI data BuildOptsCLI = BuildOptsCLI { boptsCLITargets :: ![Text] , boptsCLIDryrun :: !Bool , boptsCLIGhcOptions :: ![Text] , boptsCLIFlags :: !(Map (Maybe PackageName) (Map FlagName Bool)) , boptsCLIBuildSubset :: !BuildSubset , boptsCLIFileWatch :: !FileWatchOpts , boptsCLIExec :: ![(String, [String])] , boptsCLIOnlyConfigure :: !Bool , boptsCLICommand :: !BuildCommand } deriving Show -- | Command sum type for conditional arguments. data BuildCommand = Build | Test | Haddock | Bench | Install deriving (Eq, Show) -- | Build options that may be specified in the stack.yaml or from the CLI data BuildOptsMonoid = BuildOptsMonoid { buildMonoidLibProfile :: !(First Bool) , buildMonoidExeProfile :: !(First Bool) , buildMonoidHaddock :: !(First Bool) , buildMonoidHaddockOpts :: !HaddockOptsMonoid , buildMonoidOpenHaddocks :: !(First Bool) , buildMonoidHaddockDeps :: !(First Bool) , buildMonoidInstallExes :: !(First Bool) , buildMonoidPreFetch :: !(First Bool) , buildMonoidKeepGoing :: !(First Bool) , buildMonoidForceDirty :: !(First Bool) , buildMonoidTests :: !(First Bool) , buildMonoidTestOpts :: !TestOptsMonoid , buildMonoidBenchmarks :: !(First Bool) , buildMonoidBenchmarkOpts :: !BenchmarkOptsMonoid , buildMonoidReconfigure :: !(First Bool) , buildMonoidCabalVerbose :: !(First Bool) , buildMonoidSplitObjs :: !(First Bool) } deriving (Show, Generic) instance FromJSON (WithJSONWarnings BuildOptsMonoid) where parseJSON = withObjectWarnings "BuildOptsMonoid" (\o -> do buildMonoidLibProfile <- First <$> o ..:? buildMonoidLibProfileArgName buildMonoidExeProfile <-First <$> o ..:? buildMonoidExeProfileArgName buildMonoidHaddock <- First <$> o ..:? buildMonoidHaddockArgName buildMonoidHaddockOpts <- jsonSubWarnings (o ..:? buildMonoidHaddockOptsArgName ..!= mempty) buildMonoidOpenHaddocks <- First <$> o ..:? buildMonoidOpenHaddocksArgName buildMonoidHaddockDeps <- First <$> o ..:? buildMonoidHaddockDepsArgName buildMonoidInstallExes <- First <$> o ..:? buildMonoidInstallExesArgName buildMonoidPreFetch <- First <$> o ..:? buildMonoidPreFetchArgName buildMonoidKeepGoing <- First <$> o ..:? buildMonoidKeepGoingArgName buildMonoidForceDirty <- First <$> o ..:? buildMonoidForceDirtyArgName buildMonoidTests <- First <$> o ..:? buildMonoidTestsArgName buildMonoidTestOpts <- jsonSubWarnings (o ..:? buildMonoidTestOptsArgName ..!= mempty) buildMonoidBenchmarks <- First <$> o ..:? buildMonoidBenchmarksArgName buildMonoidBenchmarkOpts <- jsonSubWarnings (o ..:? buildMonoidBenchmarkOptsArgName ..!= mempty) buildMonoidReconfigure <- First <$> o ..:? buildMonoidReconfigureArgName buildMonoidCabalVerbose <- First <$> o ..:? buildMonoidCabalVerboseArgName buildMonoidSplitObjs <- First <$> o ..:? buildMonoidSplitObjsName return BuildOptsMonoid{..}) buildMonoidLibProfileArgName :: Text buildMonoidLibProfileArgName = "library-profiling" buildMonoidExeProfileArgName :: Text buildMonoidExeProfileArgName = "executable-profiling" buildMonoidHaddockArgName :: Text buildMonoidHaddockArgName = "haddock" buildMonoidHaddockOptsArgName :: Text buildMonoidHaddockOptsArgName = "haddock-arguments" buildMonoidOpenHaddocksArgName :: Text buildMonoidOpenHaddocksArgName = "open-haddocks" buildMonoidHaddockDepsArgName :: Text buildMonoidHaddockDepsArgName = "haddock-deps" buildMonoidInstallExesArgName :: Text buildMonoidInstallExesArgName = "copy-bins" buildMonoidPreFetchArgName :: Text buildMonoidPreFetchArgName = "prefetch" buildMonoidKeepGoingArgName :: Text buildMonoidKeepGoingArgName = "keep-going" buildMonoidForceDirtyArgName :: Text buildMonoidForceDirtyArgName = "force-dirty" buildMonoidTestsArgName :: Text buildMonoidTestsArgName = "test" buildMonoidTestOptsArgName :: Text buildMonoidTestOptsArgName = "test-arguments" buildMonoidBenchmarksArgName :: Text buildMonoidBenchmarksArgName = "bench" buildMonoidBenchmarkOptsArgName :: Text buildMonoidBenchmarkOptsArgName = "benchmark-opts" buildMonoidReconfigureArgName :: Text buildMonoidReconfigureArgName = "reconfigure" buildMonoidCabalVerboseArgName :: Text buildMonoidCabalVerboseArgName = "cabal-verbose" buildMonoidSplitObjsName :: Text buildMonoidSplitObjsName = "split-objs" instance Monoid BuildOptsMonoid where mempty = memptydefault mappend = mappenddefault -- | Which subset of packages to build data BuildSubset = BSAll | BSOnlySnapshot -- ^ Only install packages in the snapshot database, skipping -- packages intended for the local database. | BSOnlyDependencies deriving (Show, Eq) -- | Options for the 'FinalAction' 'DoTests' data TestOpts = TestOpts {toRerunTests :: !Bool -- ^ Whether successful tests will be run gain ,toAdditionalArgs :: ![String] -- ^ Arguments passed to the test program ,toCoverage :: !Bool -- ^ Generate a code coverage report ,toDisableRun :: !Bool -- ^ Disable running of tests } deriving (Eq,Show) defaultTestOpts :: TestOpts defaultTestOpts = TestOpts { toRerunTests = True , toAdditionalArgs = [] , toCoverage = False , toDisableRun = False } data TestOptsMonoid = TestOptsMonoid { toMonoidRerunTests :: !(First Bool) , toMonoidAdditionalArgs :: ![String] , toMonoidCoverage :: !(First Bool) , toMonoidDisableRun :: !(First Bool) } deriving (Show, Generic) instance FromJSON (WithJSONWarnings TestOptsMonoid) where parseJSON = withObjectWarnings "TestOptsMonoid" (\o -> do toMonoidRerunTests <- First <$> o ..:? toMonoidRerunTestsArgName toMonoidAdditionalArgs <- o ..:? toMonoidAdditionalArgsName ..!= [] toMonoidCoverage <- First <$> o ..:? toMonoidCoverageArgName toMonoidDisableRun <- First <$> o ..:? toMonoidDisableRunArgName return TestOptsMonoid{..}) toMonoidRerunTestsArgName :: Text toMonoidRerunTestsArgName = "rerun-tests" toMonoidAdditionalArgsName :: Text toMonoidAdditionalArgsName = "additional-args" toMonoidCoverageArgName :: Text toMonoidCoverageArgName = "coverage" toMonoidDisableRunArgName :: Text toMonoidDisableRunArgName = "no-run-tests" instance Monoid TestOptsMonoid where mempty = memptydefault mappend = mappenddefault -- | Haddock Options data HaddockOpts = HaddockOpts { toHaddockArgs :: ![String] -- ^ Arguments passed to haddock program } deriving (Eq,Show) data HaddockOptsMonoid = HaddockOptsMonoid {toMonoidHaddockArgs :: ![String] } deriving (Show, Generic) defaultHaddockOpts :: HaddockOpts defaultHaddockOpts = HaddockOpts {toHaddockArgs = []} instance FromJSON (WithJSONWarnings HaddockOptsMonoid) where parseJSON = withObjectWarnings "HaddockOptsMonoid" (\o -> do toMonoidHaddockArgs <- o ..:? toMonoidHaddockArgsName ..!= [] return HaddockOptsMonoid{..}) instance Monoid HaddockOptsMonoid where mempty = memptydefault mappend = mappenddefault toMonoidHaddockArgsName :: Text toMonoidHaddockArgsName = "haddock-args" -- | Options for the 'FinalAction' 'DoBenchmarks' data BenchmarkOpts = BenchmarkOpts { beoAdditionalArgs :: !(Maybe String) -- ^ Arguments passed to the benchmark program , beoDisableRun :: !Bool -- ^ Disable running of benchmarks } deriving (Eq,Show) defaultBenchmarkOpts :: BenchmarkOpts defaultBenchmarkOpts = BenchmarkOpts { beoAdditionalArgs = Nothing , beoDisableRun = False } data BenchmarkOptsMonoid = BenchmarkOptsMonoid { beoMonoidAdditionalArgs :: !(First String) , beoMonoidDisableRun :: !(First Bool) } deriving (Show, Generic) instance FromJSON (WithJSONWarnings BenchmarkOptsMonoid) where parseJSON = withObjectWarnings "BenchmarkOptsMonoid" (\o -> do beoMonoidAdditionalArgs <- First <$> o ..:? beoMonoidAdditionalArgsArgName beoMonoidDisableRun <- First <$> o ..:? beoMonoidDisableRunArgName return BenchmarkOptsMonoid{..}) beoMonoidAdditionalArgsArgName :: Text beoMonoidAdditionalArgsArgName = "benchmark-arguments" beoMonoidDisableRunArgName :: Text beoMonoidDisableRunArgName = "no-run-benchmarks" instance Monoid BenchmarkOptsMonoid where mempty = memptydefault mappend = mappenddefault data FileWatchOpts = NoFileWatch | FileWatch | FileWatchPoll deriving (Show,Eq) stack-1.1.2/src/Stack/Types/Docker.hs0000644000000000000000000002457212717707441015535 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Docker types. module Stack.Types.Docker where import Control.Applicative import Control.Monad import Control.Monad.Catch (MonadThrow) import Data.Aeson.Extended import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import Distribution.Text (simpleParse) import Distribution.Version (anyVersion) import GHC.Generics (Generic) import Generics.Deriving.Monoid (mappenddefault, memptydefault) import Path import Stack.Types.Version -- | Docker configuration. data DockerOpts = DockerOpts {dockerEnable :: !Bool -- ^ Is using Docker enabled? ,dockerImage :: !String -- ^ Exact Docker image tag or ID. Overrides docker-repo-*/tag. ,dockerRegistryLogin :: !Bool -- ^ Does registry require login for pulls? ,dockerRegistryUsername :: !(Maybe String) -- ^ Optional username for Docker registry. ,dockerRegistryPassword :: !(Maybe String) -- ^ Optional password for Docker registry. ,dockerAutoPull :: !Bool -- ^ Automatically pull new images. ,dockerDetach :: !Bool -- ^ Whether to run a detached container ,dockerPersist :: !Bool -- ^ Create a persistent container (don't remove it when finished). Implied by -- `dockerDetach`. ,dockerContainerName :: !(Maybe String) -- ^ Container name to use, only makes sense from command-line with `dockerPersist` -- or `dockerDetach`. ,dockerRunArgs :: ![String] -- ^ Arguments to pass directly to @docker run@. ,dockerMount :: ![Mount] -- ^ Volumes to mount in the container. ,dockerEnv :: ![String] -- ^ Environment variables to set in the container. ,dockerDatabasePath :: !(Path Abs File) -- ^ Location of image usage database. ,dockerStackExe :: !(Maybe DockerStackExe) -- ^ Location of container-compatible stack executable ,dockerSetUser :: !(Maybe Bool) -- ^ Set in-container user to match host's ,dockerRequireDockerVersion :: !VersionRange -- ^ Require a version of Docker within this range. } deriving (Show) -- | An uninterpreted representation of docker options. -- Configurations may be "cascaded" using mappend (left-biased). data DockerOptsMonoid = DockerOptsMonoid {dockerMonoidDefaultEnable :: !Any -- ^ Should Docker be defaulted to enabled (does @docker:@ section exist in the config)? ,dockerMonoidEnable :: !(First Bool) -- ^ Is using Docker enabled? ,dockerMonoidRepoOrImage :: !(First DockerMonoidRepoOrImage) -- ^ Docker repository name (e.g. @fpco/stack-build@ or @fpco/stack-full:lts-2.8@) ,dockerMonoidRegistryLogin :: !(First Bool) -- ^ Does registry require login for pulls? ,dockerMonoidRegistryUsername :: !(First String) -- ^ Optional username for Docker registry. ,dockerMonoidRegistryPassword :: !(First String) -- ^ Optional password for Docker registry. ,dockerMonoidAutoPull :: !(First Bool) -- ^ Automatically pull new images. ,dockerMonoidDetach :: !(First Bool) -- ^ Whether to run a detached container ,dockerMonoidPersist :: !(First Bool) -- ^ Create a persistent container (don't remove it when finished). Implied by -- `dockerDetach`. ,dockerMonoidContainerName :: !(First String) -- ^ Container name to use, only makes sense from command-line with `dockerPersist` -- or `dockerDetach`. ,dockerMonoidRunArgs :: ![String] -- ^ Arguments to pass directly to @docker run@ ,dockerMonoidMount :: ![Mount] -- ^ Volumes to mount in the container ,dockerMonoidEnv :: ![String] -- ^ Environment variables to set in the container ,dockerMonoidDatabasePath :: !(First String) -- ^ Location of image usage database. ,dockerMonoidStackExe :: !(First String) -- ^ Location of container-compatible stack executable ,dockerMonoidSetUser :: !(First Bool) -- ^ Set in-container user to match host's ,dockerMonoidRequireDockerVersion :: !IntersectingVersionRange -- ^ See: 'dockerRequireDockerVersion' } deriving (Show, Generic) -- | Decode uninterpreted docker options from JSON/YAML. instance FromJSON (WithJSONWarnings DockerOptsMonoid) where parseJSON = withObjectWarnings "DockerOptsMonoid" (\o -> do dockerMonoidDefaultEnable <- pure (Any True) dockerMonoidEnable <- First <$> o ..:? dockerEnableArgName dockerMonoidRepoOrImage <- First <$> (((Just . DockerMonoidImage) <$> o ..: dockerImageArgName) <|> ((Just . DockerMonoidRepo) <$> o ..: dockerRepoArgName) <|> pure Nothing) dockerMonoidRegistryLogin <- First <$> o ..:? dockerRegistryLoginArgName dockerMonoidRegistryUsername <- First <$> o ..:? dockerRegistryUsernameArgName dockerMonoidRegistryPassword <- First <$> o ..:? dockerRegistryPasswordArgName dockerMonoidAutoPull <- First <$> o ..:? dockerAutoPullArgName dockerMonoidDetach <- First <$> o ..:? dockerDetachArgName dockerMonoidPersist <- First <$> o ..:? dockerPersistArgName dockerMonoidContainerName <- First <$> o ..:? dockerContainerNameArgName dockerMonoidRunArgs <- o ..:? dockerRunArgsArgName ..!= [] dockerMonoidMount <- o ..:? dockerMountArgName ..!= [] dockerMonoidEnv <- o ..:? dockerEnvArgName ..!= [] dockerMonoidDatabasePath <- First <$> o ..:? dockerDatabasePathArgName dockerMonoidStackExe <- First <$> o ..:? dockerStackExeArgName dockerMonoidSetUser <- First <$> o ..:? dockerSetUserArgName dockerMonoidRequireDockerVersion <- IntersectingVersionRange <$> unVersionRangeJSON <$> o ..:? dockerRequireDockerVersionArgName ..!= VersionRangeJSON anyVersion return DockerOptsMonoid{..}) -- | Left-biased combine Docker options instance Monoid DockerOptsMonoid where mempty = memptydefault mappend = mappenddefault -- | Where to get the `stack` executable to run in Docker containers data DockerStackExe = DockerStackExeDownload -- ^ Download from official bindist | DockerStackExeHost -- ^ Host's `stack` (linux-x86_64 only) | DockerStackExeImage -- ^ Docker image's `stack` (versions must match) | DockerStackExePath (Path Abs File) -- ^ Executable at given path deriving (Show) -- | Parse 'DockerStackExe'. parseDockerStackExe :: (MonadThrow m) => String -> m DockerStackExe parseDockerStackExe t | t == dockerStackExeDownloadVal = return DockerStackExeDownload | t == dockerStackExeHostVal = return DockerStackExeHost | t == dockerStackExeImageVal = return DockerStackExeImage | otherwise = liftM DockerStackExePath (parseAbsFile t) -- | Docker volume mount. data Mount = Mount String String -- | For optparse-applicative. instance Read Mount where readsPrec _ s = case break (== ':') s of (a,':':b) -> [(Mount a b,"")] (a,[]) -> [(Mount a a,"")] _ -> fail "Invalid value for Docker mount (expect '/host/path:/container/path')" -- | Show instance. instance Show Mount where show (Mount a b) = if a == b then a else concat [a,":",b] -- | For YAML. instance FromJSON Mount where parseJSON v = fmap read (parseJSON v) -- | Options for Docker repository or image. data DockerMonoidRepoOrImage = DockerMonoidRepo String | DockerMonoidImage String deriving (Show) -- | Newtype for non-orphan FromJSON instance. newtype VersionRangeJSON = VersionRangeJSON { unVersionRangeJSON :: VersionRange } -- | Parse VersionRange. instance FromJSON VersionRangeJSON where parseJSON = withText "VersionRange" (\s -> maybe (fail ("Invalid cabal-style VersionRange: " ++ T.unpack s)) (return . VersionRangeJSON) (Distribution.Text.simpleParse (T.unpack s))) -- | Docker enable argument name. dockerEnableArgName :: Text dockerEnableArgName = "enable" -- | Docker repo arg argument name. dockerRepoArgName :: Text dockerRepoArgName = "repo" -- | Docker image argument name. dockerImageArgName :: Text dockerImageArgName = "image" -- | Docker registry login argument name. dockerRegistryLoginArgName :: Text dockerRegistryLoginArgName = "registry-login" -- | Docker registry username argument name. dockerRegistryUsernameArgName :: Text dockerRegistryUsernameArgName = "registry-username" -- | Docker registry password argument name. dockerRegistryPasswordArgName :: Text dockerRegistryPasswordArgName = "registry-password" -- | Docker auto-pull argument name. dockerAutoPullArgName :: Text dockerAutoPullArgName = "auto-pull" -- | Docker detach argument name. dockerDetachArgName :: Text dockerDetachArgName = "detach" -- | Docker run args argument name. dockerRunArgsArgName :: Text dockerRunArgsArgName = "run-args" -- | Docker mount argument name. dockerMountArgName :: Text dockerMountArgName = "mount" -- | Docker environment variable argument name. dockerEnvArgName :: Text dockerEnvArgName = "env" -- | Docker container name argument name. dockerContainerNameArgName :: Text dockerContainerNameArgName = "container-name" -- | Docker persist argument name. dockerPersistArgName :: Text dockerPersistArgName = "persist" -- | Docker database path argument name. dockerDatabasePathArgName :: Text dockerDatabasePathArgName = "database-path" -- | Docker database path argument name. dockerStackExeArgName :: Text dockerStackExeArgName = "stack-exe" -- | Value for @--docker-stack-exe=download@ dockerStackExeDownloadVal :: String dockerStackExeDownloadVal = "download" -- | Value for @--docker-stack-exe=host@ dockerStackExeHostVal :: String dockerStackExeHostVal = "host" -- | Value for @--docker-stack-exe=image@ dockerStackExeImageVal :: String dockerStackExeImageVal = "image" -- | Docker @set-user@ argument name dockerSetUserArgName :: Text dockerSetUserArgName = "set-user" -- | Docker @require-version@ argument name dockerRequireDockerVersionArgName :: Text dockerRequireDockerVersionArgName = "require-docker-version" -- | Argument name used to pass docker entrypoint data (only used internally) dockerEntrypointArgName :: String dockerEntrypointArgName = "internal-docker-entrypoint" stack-1.1.2/src/Stack/Types/FlagName.hs0000644000000000000000000001016512644245454015771 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TupleSections #-} -- | Names for flags. module Stack.Types.FlagName (FlagName ,FlagNameParseFail(..) ,flagNameParser ,parseFlagName ,parseFlagNameFromString ,flagNameString ,flagNameText ,fromCabalFlagName ,toCabalFlagName ,mkFlagName) where import Control.Applicative import Control.Monad.Catch import Data.Aeson.Extended import Data.Attoparsec.Text import Data.Attoparsec.Combinators import Data.Binary.VersionTagged import Data.Char (isLetter, isDigit, toLower) import Data.Data import Data.Hashable import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as T import Data.Text.Binary () import qualified Distribution.PackageDescription as Cabal import GHC.Generics import Language.Haskell.TH import Language.Haskell.TH.Syntax -- | A parse fail. data FlagNameParseFail = FlagNameParseFail Text deriving (Typeable) instance Exception FlagNameParseFail instance Show FlagNameParseFail where show (FlagNameParseFail bs) = "Invalid flag name: " ++ show bs -- | A flag name. newtype FlagName = FlagName Text deriving (Typeable,Data,Generic,Hashable,Binary,NFData) instance HasStructuralInfo FlagName instance Eq FlagName where x == y = compare x y == EQ instance Ord FlagName where compare (FlagName x) (FlagName y) = compare (T.map toLower x) (T.map toLower y) instance Lift FlagName where lift (FlagName n) = appE (conE 'FlagName) (stringE (T.unpack n)) instance Show FlagName where show (FlagName n) = T.unpack n instance FromJSON FlagName where parseJSON j = do s <- parseJSON j case parseFlagNameFromString s of Nothing -> fail ("Couldn't parse flag name: " ++ s) Just ver -> return ver -- | Attoparsec parser for a flag name flagNameParser :: Parser FlagName flagNameParser = fmap (FlagName . T.pack) (appending (many1 (satisfy isLetter)) (concating (many (alternating (pured (satisfy isAlphaNum)) (appending (pured (satisfy separator)) (pured (satisfy isAlphaNum))))))) where separator c = c == '-' || c == '_' isAlphaNum c = isLetter c || isDigit c -- | Make a flag name. mkFlagName :: String -> Q Exp mkFlagName s = case parseFlagNameFromString s of Nothing -> error ("Invalid flag name: " ++ show s) Just pn -> [|pn|] -- | Convenient way to parse a flag name from a 'Text'. parseFlagName :: MonadThrow m => Text -> m FlagName parseFlagName x = go x where go = either (const (throwM (FlagNameParseFail x))) return . parseOnly (flagNameParser <* endOfInput) -- | Convenience function for parsing from a 'String' parseFlagNameFromString :: MonadThrow m => String -> m FlagName parseFlagNameFromString = parseFlagName . T.pack -- | Produce a string representation of a flag name. flagNameString :: FlagName -> String flagNameString (FlagName n) = T.unpack n -- | Produce a string representation of a flag name. flagNameText :: FlagName -> Text flagNameText (FlagName n) = n -- | Convert from a Cabal flag name. fromCabalFlagName :: Cabal.FlagName -> FlagName fromCabalFlagName (Cabal.FlagName name) = let !x = T.pack name in FlagName x -- | Convert to a Cabal flag name. toCabalFlagName :: FlagName -> Cabal.FlagName toCabalFlagName (FlagName name) = let !x = T.unpack name in Cabal.FlagName x instance ToJSON a => ToJSON (Map FlagName a) where toJSON = toJSON . Map.mapKeysWith const flagNameText instance FromJSON a => FromJSON (Map FlagName a) where parseJSON val = do m <- parseJSON val fmap Map.fromList $ mapM go $ Map.toList m where go (k, v) = fmap (, v) $ either (fail . show) return $ parseFlagNameFromString k stack-1.1.2/src/Stack/Types/GhcPkgId.hs0000644000000000000000000000427612644245454015745 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} -- | A ghc-pkg id. module Stack.Types.GhcPkgId (GhcPkgId ,ghcPkgIdParser ,parseGhcPkgId ,ghcPkgIdString) where import Control.Applicative import Control.Monad.Catch import Data.Aeson.Extended import Data.Attoparsec.Text import Data.Binary (getWord8, putWord8) import Data.Binary.VersionTagged import Data.Data import Data.Hashable import Data.Text (Text) import qualified Data.Text as T import GHC.Generics import Prelude -- Fix AMP warning -- | A parse fail. data GhcPkgIdParseFail = GhcPkgIdParseFail Text deriving Typeable instance Show GhcPkgIdParseFail where show (GhcPkgIdParseFail bs) = "Invalid package ID: " ++ show bs instance Exception GhcPkgIdParseFail -- | A ghc-pkg package identifier. newtype GhcPkgId = GhcPkgId Text deriving (Eq,Ord,Data,Typeable,Generic) instance Hashable GhcPkgId instance Binary GhcPkgId where put (GhcPkgId x) = do -- magic string putWord8 1 putWord8 3 putWord8 4 putWord8 7 put x get = do 1 <- getWord8 3 <- getWord8 4 <- getWord8 7 <- getWord8 fmap GhcPkgId get instance NFData GhcPkgId instance HasStructuralInfo GhcPkgId instance Show GhcPkgId where show = show . ghcPkgIdString instance FromJSON GhcPkgId where parseJSON = withText "GhcPkgId" $ \t -> case parseGhcPkgId t of Left e -> fail $ show (e, t) Right x -> return x instance ToJSON GhcPkgId where toJSON g = toJSON (ghcPkgIdString g) -- | Convenient way to parse a package name from a 'Text'. parseGhcPkgId :: MonadThrow m => Text -> m GhcPkgId parseGhcPkgId x = go x where go = either (const (throwM (GhcPkgIdParseFail x))) return . parseOnly (ghcPkgIdParser <* endOfInput) -- | A parser for a package-version-hash pair. ghcPkgIdParser :: Parser GhcPkgId ghcPkgIdParser = GhcPkgId . T.pack <$> many1 (choice [digit, letter, satisfy (`elem` "_.-")]) -- | Get a string representation of GHC package id. ghcPkgIdString :: GhcPkgId -> String ghcPkgIdString (GhcPkgId x) = T.unpack x stack-1.1.2/src/Stack/Types/Image.hs0000644000000000000000000000655412717707441015350 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} module Stack.Types.Image where import Data.Aeson.Extended import Data.Monoid import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (maybeToList) import Data.Text (Text) import GHC.Generics (Generic) import Generics.Deriving.Monoid (mappenddefault, memptydefault) import Prelude -- Fix redundant import warnings -- | Image options. Currently only Docker image options. data ImageOpts = ImageOpts { imgDockers :: ![ImageDockerOpts] -- ^ One or more stanzas for docker image settings. } deriving (Show) data ImageDockerOpts = ImageDockerOpts { imgDockerBase :: !(Maybe String) -- ^ Maybe have a docker base image name. (Although we will not -- be able to create any Docker images without this.) , imgDockerEntrypoints :: !(Maybe [String]) -- ^ Maybe have a specific ENTRYPOINT list that will be used to -- create images. , imgDockerAdd :: !(Map FilePath FilePath) -- ^ Maybe have some static project content to include in a -- specific directory in all the images. , imgDockerImageName :: !(Maybe String) -- ^ Maybe have a name for the image we are creating , imgDockerExecutables :: !(Maybe [FilePath]) -- ^ Filenames of executables to add (if Nothing, add them all) } deriving (Show) data ImageOptsMonoid = ImageOptsMonoid { imgMonoidDockers :: ![ImageDockerOpts] } deriving (Show, Generic) instance FromJSON (WithJSONWarnings ImageOptsMonoid) where parseJSON = withObjectWarnings "ImageOptsMonoid" (\o -> do (oldDocker :: Maybe ImageDockerOpts) <- jsonSubWarningsT (o ..:? imgDockerOldArgName) (dockers :: [ImageDockerOpts]) <- jsonSubWarningsT (o ..:? imgDockersArgName ..!= []) let imgMonoidDockers = dockers ++ maybeToList oldDocker return ImageOptsMonoid { .. }) instance Monoid ImageOptsMonoid where mempty = memptydefault mappend = mappenddefault instance FromJSON (WithJSONWarnings ImageDockerOpts) where parseJSON = withObjectWarnings "ImageDockerOpts" (\o -> do imgDockerBase <- o ..:? imgDockerBaseArgName imgDockerEntrypoints <- o ..:? imgDockerEntrypointsArgName imgDockerAdd <- o ..:? imgDockerAddArgName ..!= Map.empty imgDockerImageName <- o ..:? imgDockerImageNameArgName imgDockerExecutables <- o ..:? imgDockerExecutablesArgName return ImageDockerOpts { .. }) imgArgName :: Text imgArgName = "image" -- Kept for backward compatibility imgDockerOldArgName :: Text imgDockerOldArgName = "container" imgDockersArgName :: Text imgDockersArgName = "containers" imgDockerBaseArgName :: Text imgDockerBaseArgName = "base" imgDockerAddArgName :: Text imgDockerAddArgName = "add" imgDockerEntrypointsArgName :: Text imgDockerEntrypointsArgName = "entrypoints" imgDockerImageNameArgName :: Text imgDockerImageNameArgName = "name" imgDockerExecutablesArgName :: Text imgDockerExecutablesArgName = "executables" stack-1.1.2/src/Stack/Types/Internal.hs0000644000000000000000000001003412717707441016066 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} -- | Internal types to the library. module Stack.Types.Internal where import Control.Concurrent.MVar import Control.Monad.Logger (LogLevel) import Data.Monoid.Extra import Data.Text (Text) import Lens.Micro import Network.HTTP.Client.Conduit (Manager,HasHttpManager(..)) import Stack.Types.Config -- | Monadic environment. data Env config = Env {envConfig :: !config ,envLogLevel :: !LogLevel ,envTerminal :: !Bool ,envReExec :: !Bool ,envManager :: !Manager ,envSticky :: !Sticky ,envSupportsUnicode :: !Bool} instance HasStackRoot config => HasStackRoot (Env config) where getStackRoot = getStackRoot . envConfig instance HasPlatform config => HasPlatform (Env config) where getPlatform = getPlatform . envConfig getPlatformVariant = getPlatformVariant . envConfig instance HasGHCVariant config => HasGHCVariant (Env config) where getGHCVariant = getGHCVariant . envConfig instance HasConfig config => HasConfig (Env config) where getConfig = getConfig . envConfig instance HasBuildConfig config => HasBuildConfig (Env config) where getBuildConfig = getBuildConfig . envConfig instance HasEnvConfig config => HasEnvConfig (Env config) where getEnvConfig = getEnvConfig . envConfig instance HasHttpManager (Env config) where getHttpManager = envManager class HasLogLevel r where getLogLevel :: r -> LogLevel instance HasLogLevel (Env config) where getLogLevel = envLogLevel instance HasLogLevel LogLevel where getLogLevel = id class HasTerminal r where getTerminal :: r -> Bool instance HasTerminal (Env config) where getTerminal = envTerminal class HasReExec r where getReExec :: r -> Bool instance HasReExec (Env config) where getReExec = envReExec class HasSupportsUnicode r where getSupportsUnicode :: r -> Bool instance HasSupportsUnicode (Env config) where getSupportsUnicode = envSupportsUnicode newtype Sticky = Sticky { unSticky :: Maybe (MVar (Maybe Text)) } class HasSticky r where getSticky :: r -> Sticky instance HasSticky (Env config) where getSticky = envSticky envEnvConfig :: Lens' (Env EnvConfig) EnvConfig envEnvConfig = lens (envConfig) (\s t -> s {envConfig = t}) buildOptsMonoidHaddock :: Lens' BuildOptsMonoid (Maybe Bool) buildOptsMonoidHaddock = lens (getFirst . buildMonoidHaddock) (\buildMonoid t -> buildMonoid {buildMonoidHaddock = First t}) buildOptsMonoidTests :: Lens' BuildOptsMonoid (Maybe Bool) buildOptsMonoidTests = lens (getFirst . buildMonoidTests) (\buildMonoid t -> buildMonoid {buildMonoidTests = First t}) buildOptsMonoidBenchmarks :: Lens' BuildOptsMonoid (Maybe Bool) buildOptsMonoidBenchmarks = lens (getFirst . buildMonoidBenchmarks) (\buildMonoid t -> buildMonoid {buildMonoidBenchmarks = First t}) buildOptsMonoidInstallExes :: Lens' BuildOptsMonoid (Maybe Bool) buildOptsMonoidInstallExes = lens (getFirst . buildMonoidInstallExes) (\buildMonoid t -> buildMonoid {buildMonoidInstallExes = First t}) buildOptsInstallExes :: Lens' BuildOpts Bool buildOptsInstallExes = lens (boptsInstallExes) (\bopts t -> bopts {boptsInstallExes = t}) envConfigBuildOpts :: Lens' EnvConfig BuildOpts envConfigBuildOpts = lens (\envCfg -> configBuild (bcConfig (envConfigBuildConfig envCfg))) (\envCfg bopts -> envCfg { envConfigBuildConfig = (envConfigBuildConfig envCfg) { bcConfig = (bcConfig (envConfigBuildConfig envCfg)) { configBuild = bopts } } }) globalOptsBuildOptsMonoid :: Lens' GlobalOpts BuildOptsMonoid globalOptsBuildOptsMonoid = lens (\globalOpts -> configMonoidBuildOpts (globalConfigMonoid globalOpts)) (\globalOpts boptsMonoid -> globalOpts { globalConfigMonoid = (globalConfigMonoid globalOpts) { configMonoidBuildOpts = boptsMonoid } }) stack-1.1.2/src/Stack/Types/Nix.hs0000644000000000000000000000622712717707441015061 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Nix types. module Stack.Types.Nix where import Control.Applicative import Data.Aeson.Extended import Data.Text (Text) import Data.Monoid import GHC.Generics (Generic) import Generics.Deriving.Monoid (mappenddefault, memptydefault) import Prelude -- | Nix configuration. Parameterize by resolver type to avoid cyclic -- dependency. data NixOpts = NixOpts {nixEnable :: !Bool ,nixPureShell :: !Bool ,nixPackages :: ![Text] -- ^ The system packages to be installed in the environment before it runs ,nixInitFile :: !(Maybe FilePath) -- ^ The path of a file containing preconfiguration of the environment (e.g shell.nix) ,nixShellOptions :: ![Text] -- ^ Options to be given to the nix-shell command line } deriving (Show) -- | An uninterpreted representation of nix options. -- Configurations may be "cascaded" using mappend (left-biased). data NixOptsMonoid = NixOptsMonoid {nixMonoidDefaultEnable :: !Any -- ^ Should nix-shell be defaulted to enabled (does @nix:@ section exist in the config)? ,nixMonoidEnable :: !(First Bool) -- ^ Is using nix-shell enabled? ,nixMonoidPureShell :: !(First Bool) -- ^ Should the nix-shell be pure ,nixMonoidPackages :: !(First [Text]) -- ^ System packages to use (given to nix-shell) ,nixMonoidInitFile :: !(First FilePath) -- ^ The path of a file containing preconfiguration of the environment (e.g shell.nix) ,nixMonoidShellOptions :: !(First [Text]) -- ^ Options to be given to the nix-shell command line ,nixMonoidPath :: !(First [Text]) -- ^ Override parts of NIX_PATH (notably 'nixpkgs') } deriving (Eq, Show, Generic) -- | Decode uninterpreted nix options from JSON/YAML. instance FromJSON (WithJSONWarnings NixOptsMonoid) where parseJSON = withObjectWarnings "NixOptsMonoid" (\o -> do nixMonoidDefaultEnable <- pure (Any False) nixMonoidEnable <- First <$> o ..:? nixEnableArgName nixMonoidPureShell <- First <$> o ..:? nixPureShellArgName nixMonoidPackages <- First <$> o ..:? nixPackagesArgName nixMonoidInitFile <- First <$> o ..:? nixInitFileArgName nixMonoidShellOptions <- First <$> o ..:? nixShellOptsArgName nixMonoidPath <- First <$> o ..:? nixPathArgName return NixOptsMonoid{..}) -- | Left-biased combine Nix options instance Monoid NixOptsMonoid where mempty = memptydefault mappend = mappenddefault -- | Nix enable argument name. nixEnableArgName :: Text nixEnableArgName = "enable" -- | Nix run in pure shell argument name. nixPureShellArgName :: Text nixPureShellArgName = "pure" -- | Nix packages (build inputs) argument name. nixPackagesArgName :: Text nixPackagesArgName = "packages" -- | shell.nix file path argument name. nixInitFileArgName :: Text nixInitFileArgName = "shell-file" -- | Extra options for the nix-shell command argument name. nixShellOptsArgName :: Text nixShellOptsArgName = "nix-shell-options" -- | NIX_PATH override argument name nixPathArgName :: Text nixPathArgName = "path" stack-1.1.2/src/Stack/Types/Package.hs0000644000000000000000000004046512717707441015660 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -- | module Stack.Types.Package where import Control.DeepSeq import Control.Exception hiding (try,catch) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger (MonadLogger) import Control.Monad.Reader import Data.Binary import Data.Binary.VersionTagged import qualified Data.ByteString as S import Data.Data import Data.Function import Data.List import qualified Data.Map as M import Data.Map.Strict (Map) import Data.Maybe import Data.Monoid import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Distribution.InstalledPackageInfo (PError) import Distribution.ModuleName (ModuleName) import Distribution.Package hiding (Package,PackageName,packageName,packageVersion,PackageIdentifier) import Distribution.PackageDescription (TestSuiteInterface) import Distribution.System (Platform (..)) import Distribution.Text (display) import GHC.Generics (Generic) import Path as FL import Prelude import Stack.Types.BuildPlan (GitSHA1) import Stack.Types.Compiler import Stack.Types.Config import Stack.Types.FlagName import Stack.Types.GhcPkgId import Stack.Types.PackageIdentifier import Stack.Types.PackageName import Stack.Types.Version -- | All exceptions thrown by the library. data PackageException = PackageInvalidCabalFile (Maybe (Path Abs File)) PError | PackageNoCabalFileFound (Path Abs Dir) | PackageMultipleCabalFilesFound (Path Abs Dir) [Path Abs File] | MismatchedCabalName (Path Abs File) PackageName deriving Typeable instance Exception PackageException instance Show PackageException where show (PackageInvalidCabalFile mfile err) = "Unable to parse cabal file" ++ (case mfile of Nothing -> "" Just file -> ' ' : toFilePath file) ++ ": " ++ show err show (PackageNoCabalFileFound dir) = "No .cabal file found in directory " ++ toFilePath dir show (PackageMultipleCabalFilesFound dir files) = "Multiple .cabal files found in directory " ++ toFilePath dir ++ ": " ++ intercalate ", " (map (toFilePath . filename) files) show (MismatchedCabalName fp name) = concat [ "cabal file path " , toFilePath fp , " does not match the package name it defines.\n" , "Please rename the file to: " , packageNameString name , ".cabal\n" , "For more information, see: https://github.com/commercialhaskell/stack/issues/317" ] -- | Some package info. data Package = Package {packageName :: !PackageName -- ^ Name of the package. ,packageVersion :: !Version -- ^ Version of the package ,packageFiles :: !GetPackageFiles -- ^ Get all files of the package. ,packageDeps :: !(Map PackageName VersionRange) -- ^ Packages that the package depends on. ,packageTools :: ![Dependency] -- ^ A build tool name. ,packageAllDeps :: !(Set PackageName) -- ^ Original dependencies (not sieved). ,packageGhcOptions :: ![Text] -- ^ Ghc options used on package. ,packageFlags :: !(Map FlagName Bool) -- ^ Flags used on package. ,packageDefaultFlags :: !(Map FlagName Bool) -- ^ Defaults for unspecified flags. ,packageHasLibrary :: !Bool -- ^ does the package have a buildable library stanza? ,packageTests :: !(Map Text TestSuiteInterface) -- ^ names and interfaces of test suites ,packageBenchmarks :: !(Set Text) -- ^ names of benchmarks ,packageExes :: !(Set Text) -- ^ names of executables ,packageOpts :: !GetPackageOpts -- ^ Args to pass to GHC. ,packageHasExposedModules :: !Bool -- ^ Does the package have exposed modules? ,packageSimpleType :: !Bool -- ^ Does the package of build-type: Simple } deriving (Show,Typeable) packageIdentifier :: Package -> PackageIdentifier packageIdentifier pkg = PackageIdentifier (packageName pkg) (packageVersion pkg) packageDefinedFlags :: Package -> Set FlagName packageDefinedFlags = M.keysSet . packageDefaultFlags -- | Files that the package depends on, relative to package directory. -- Argument is the location of the .cabal file newtype GetPackageOpts = GetPackageOpts { getPackageOpts :: forall env m. (MonadIO m,HasEnvConfig env, HasPlatform env, MonadThrow m, MonadReader env m, MonadLogger m, MonadCatch m) => SourceMap -> InstalledMap -> [PackageName] -> [PackageName] -> Path Abs File -> m (Map NamedComponent (Set ModuleName) ,Map NamedComponent (Set DotCabalPath) ,Map NamedComponent BuildInfoOpts) } instance Show GetPackageOpts where show _ = "" -- | GHC options based on cabal information and ghc-options. data BuildInfoOpts = BuildInfoOpts { bioOpts :: [String] , bioOneWordOpts :: [String] , bioPackageFlags :: [String] -- ^ These options can safely have 'nubOrd' applied to them, as -- there are no multi-word options (see -- https://github.com/commercialhaskell/stack/issues/1255) , bioCabalMacros :: Maybe (Path Abs File) } deriving Show -- | Files to get for a cabal package. data CabalFileType = AllFiles | Modules -- | Files that the package depends on, relative to package directory. -- Argument is the location of the .cabal file newtype GetPackageFiles = GetPackageFiles { getPackageFiles :: forall m env. (MonadIO m, MonadLogger m, MonadThrow m, MonadCatch m, MonadReader env m, HasPlatform env, HasEnvConfig env) => Path Abs File -> m (Map NamedComponent (Set ModuleName) ,Map NamedComponent (Set DotCabalPath) ,Set (Path Abs File) ,[PackageWarning]) } instance Show GetPackageFiles where show _ = "" -- | Warning generated when reading a package data PackageWarning = UnlistedModulesWarning (Path Abs File) (Maybe String) [ModuleName] -- ^ Modules found that are not listed in cabal file | MissingModulesWarning (Path Abs File) (Maybe String) [ModuleName] -- ^ Modules not found in file system, which are listed in cabal file instance Show PackageWarning where show (UnlistedModulesWarning cabalfp component [unlistedModule]) = concat [ "module not listed in " , toFilePath (filename cabalfp) , case component of Nothing -> " for library" Just c -> " for '" ++ c ++ "'" , " component (add to other-modules): " , display unlistedModule] show (UnlistedModulesWarning cabalfp component unlistedModules) = concat [ "modules not listed in " , toFilePath (filename cabalfp) , case component of Nothing -> " for library" Just c -> " for '" ++ c ++ "'" , " component (add to other-modules):\n " , intercalate "\n " (map display unlistedModules)] show (MissingModulesWarning cabalfp component [missingModule]) = concat [ "module listed in " , toFilePath (filename cabalfp) , case component of Nothing -> " for library" Just c -> " for '" ++ c ++ "'" , " component not found in filesystem: " , display missingModule] show (MissingModulesWarning cabalfp component missingModules) = concat [ "modules listed in " , toFilePath (filename cabalfp) , case component of Nothing -> " for library" Just c -> " for '" ++ c ++ "'" , " component not found in filesystem:\n " , intercalate "\n " (map display missingModules)] -- | Package build configuration data PackageConfig = PackageConfig {packageConfigEnableTests :: !Bool -- ^ Are tests enabled? ,packageConfigEnableBenchmarks :: !Bool -- ^ Are benchmarks enabled? ,packageConfigFlags :: !(Map FlagName Bool) -- ^ Configured flags. ,packageConfigGhcOptions :: ![Text] -- ^ Configured ghc options. ,packageConfigCompilerVersion :: !CompilerVersion -- ^ GHC version ,packageConfigPlatform :: !Platform -- ^ host platform } deriving (Show,Typeable) -- | Compares the package name. instance Ord Package where compare = on compare packageName -- | Compares the package name. instance Eq Package where (==) = on (==) packageName type SourceMap = Map PackageName PackageSource -- | Where the package's source is located: local directory or package index data PackageSource = PSLocal LocalPackage | PSUpstream Version InstallLocation (Map FlagName Bool) [Text] (Maybe GitSHA1) -- ^ Upstream packages could be installed in either local or snapshot -- databases; this is what 'InstallLocation' specifies. deriving Show instance PackageInstallInfo PackageSource where piiVersion (PSLocal lp) = packageVersion $ lpPackage lp piiVersion (PSUpstream v _ _ _ _) = v piiLocation (PSLocal _) = Local piiLocation (PSUpstream _ loc _ _ _) = loc -- | Datatype which tells how which version of a package to install and where -- to install it into class PackageInstallInfo a where piiVersion :: a -> Version piiLocation :: a -> InstallLocation -- | Information on a locally available package of source code data LocalPackage = LocalPackage { lpPackage :: !Package -- ^ The @Package@ info itself, after resolution with package flags, -- with tests and benchmarks disabled , lpComponents :: !(Set NamedComponent) -- ^ Components to build, not including the library component. , lpUnbuildable :: !(Set NamedComponent) -- ^ Components explicitly requested for build, that are marked -- "buildable: false". , lpWanted :: !Bool -- ^ Whether this package is wanted as a target. , lpTestDeps :: !(Map PackageName VersionRange) -- ^ Used for determining if we can use --enable-tests in a normal build. , lpBenchDeps :: !(Map PackageName VersionRange) -- ^ Used for determining if we can use --enable-benchmarks in a normal -- build. , lpTestBench :: !(Maybe Package) -- ^ This stores the 'Package' with tests and benchmarks enabled, if -- either is asked for by the user. , lpDir :: !(Path Abs Dir) -- ^ Directory of the package. , lpCabalFile :: !(Path Abs File) -- ^ The .cabal file , lpForceDirty :: !Bool , lpDirtyFiles :: !(Maybe (Set FilePath)) -- ^ Nothing == not dirty, Just == dirty. Note that the Set may be empty if -- we forced the build to treat packages as dirty. Also, the Set may not -- include all modified files. , lpNewBuildCache :: !(Map FilePath FileCacheInfo) -- ^ current state of the files , lpFiles :: !(Set (Path Abs File)) -- ^ all files used by this package } deriving Show -- | A single, fully resolved component of a package data NamedComponent = CLib | CExe !Text | CTest !Text | CBench !Text deriving (Show, Eq, Ord) renderComponent :: NamedComponent -> S.ByteString renderComponent CLib = "lib" renderComponent (CExe x) = "exe:" <> encodeUtf8 x renderComponent (CTest x) = "test:" <> encodeUtf8 x renderComponent (CBench x) = "bench:" <> encodeUtf8 x renderPkgComponents :: [(PackageName, NamedComponent)] -> Text renderPkgComponents = T.intercalate " " . map renderPkgComponent renderPkgComponent :: (PackageName, NamedComponent) -> Text renderPkgComponent (pkg, comp) = packageNameText pkg <> ":" <> decodeUtf8 (renderComponent comp) exeComponents :: Set NamedComponent -> Set Text exeComponents = Set.fromList . mapMaybe mExeName . Set.toList where mExeName (CExe name) = Just name mExeName _ = Nothing testComponents :: Set NamedComponent -> Set Text testComponents = Set.fromList . mapMaybe mTestName . Set.toList where mTestName (CTest name) = Just name mTestName _ = Nothing benchComponents :: Set NamedComponent -> Set Text benchComponents = Set.fromList . mapMaybe mBenchName . Set.toList where mBenchName (CBench name) = Just name mBenchName _ = Nothing isCLib :: NamedComponent -> Bool isCLib CLib{} = True isCLib _ = False isCExe :: NamedComponent -> Bool isCExe CExe{} = True isCExe _ = False isCTest :: NamedComponent -> Bool isCTest CTest{} = True isCTest _ = False isCBench :: NamedComponent -> Bool isCBench CBench{} = True isCBench _ = False -- | A location to install a package into, either snapshot or local data InstallLocation = Snap | Local deriving (Show, Eq) instance Monoid InstallLocation where mempty = Snap mappend Local _ = Local mappend _ Local = Local mappend Snap Snap = Snap data InstalledPackageLocation = InstalledTo InstallLocation | ExtraGlobal deriving (Show, Eq) data FileCacheInfo = FileCacheInfo { fciModTime :: !ModTime , fciSize :: !Word64 , fciHash :: !S.ByteString } deriving (Generic, Show) instance Binary FileCacheInfo instance HasStructuralInfo FileCacheInfo instance NFData FileCacheInfo -- | Used for storage and comparison. newtype ModTime = ModTime (Integer,Rational) deriving (Ord,Show,Generic,Eq,NFData,Binary) instance HasStructuralInfo ModTime instance HasSemanticVersion ModTime -- | A descriptor from a .cabal file indicating one of the following: -- -- exposed-modules: Foo -- other-modules: Foo -- or -- main-is: Foo.hs -- data DotCabalDescriptor = DotCabalModule !ModuleName | DotCabalMain !FilePath | DotCabalFile !FilePath | DotCabalCFile !FilePath deriving (Eq,Ord,Show) -- | Maybe get the module name from the .cabal descriptor. dotCabalModule :: DotCabalDescriptor -> Maybe ModuleName dotCabalModule (DotCabalModule m) = Just m dotCabalModule _ = Nothing -- | Maybe get the main name from the .cabal descriptor. dotCabalMain :: DotCabalDescriptor -> Maybe FilePath dotCabalMain (DotCabalMain m) = Just m dotCabalMain _ = Nothing -- | A path resolved from the .cabal file, which is either main-is or -- an exposed/internal/referenced module. data DotCabalPath = DotCabalModulePath !(Path Abs File) | DotCabalMainPath !(Path Abs File) | DotCabalFilePath !(Path Abs File) | DotCabalCFilePath !(Path Abs File) deriving (Eq,Ord,Show) -- | Get the module path. dotCabalModulePath :: DotCabalPath -> Maybe (Path Abs File) dotCabalModulePath (DotCabalModulePath fp) = Just fp dotCabalModulePath _ = Nothing -- | Get the main path. dotCabalMainPath :: DotCabalPath -> Maybe (Path Abs File) dotCabalMainPath (DotCabalMainPath fp) = Just fp dotCabalMainPath _ = Nothing -- | Get the c file path. dotCabalCFilePath :: DotCabalPath -> Maybe (Path Abs File) dotCabalCFilePath (DotCabalCFilePath fp) = Just fp dotCabalCFilePath _ = Nothing -- | Get the path. dotCabalGetPath :: DotCabalPath -> Path Abs File dotCabalGetPath dcp = case dcp of DotCabalModulePath fp -> fp DotCabalMainPath fp -> fp DotCabalFilePath fp -> fp DotCabalCFilePath fp -> fp type InstalledMap = Map PackageName (InstallLocation, Installed) data Installed = Library PackageIdentifier GhcPkgId | Executable PackageIdentifier deriving (Show, Eq, Ord) installedPackageIdentifier :: Installed -> PackageIdentifier installedPackageIdentifier (Library pid _) = pid installedPackageIdentifier (Executable pid) = pid -- | Get the installed Version. installedVersion :: Installed -> Version installedVersion = packageIdentifierVersion . installedPackageIdentifier stack-1.1.2/src/Stack/Types/PackageIdentifier.hs0000644000000000000000000000703612644245454017660 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# OPTIONS -fno-warn-unused-do-bind #-} -- | Package identifier (name-version). module Stack.Types.PackageIdentifier ( PackageIdentifier(..) , toTuple , fromTuple , parsePackageIdentifier , parsePackageIdentifierFromString , packageIdentifierParser , packageIdentifierString , packageIdentifierText ) where import Control.Applicative import Control.DeepSeq import Control.Exception (Exception) import Control.Monad.Catch (MonadThrow, throwM) import Data.Aeson.Extended import Data.Attoparsec.Text import Data.Binary.VersionTagged (Binary, HasStructuralInfo) import Data.Data import Data.Hashable import Data.Text (Text) import qualified Data.Text as T import GHC.Generics import Prelude hiding (FilePath) import Stack.Types.PackageName import Stack.Types.Version -- | A parse fail. data PackageIdentifierParseFail = PackageIdentifierParseFail Text deriving (Typeable) instance Show PackageIdentifierParseFail where show (PackageIdentifierParseFail bs) = "Invalid package identifier: " ++ show bs instance Exception PackageIdentifierParseFail -- | A pkg-ver combination. data PackageIdentifier = PackageIdentifier { -- | Get the name part of the identifier. packageIdentifierName :: !PackageName -- | Get the version part of the identifier. , packageIdentifierVersion :: !Version } deriving (Eq,Ord,Generic,Data,Typeable) instance NFData PackageIdentifier where rnf (PackageIdentifier !p !v) = seq (rnf p) (rnf v) instance Hashable PackageIdentifier instance Binary PackageIdentifier instance HasStructuralInfo PackageIdentifier instance Show PackageIdentifier where show = show . packageIdentifierString instance ToJSON PackageIdentifier where toJSON = toJSON . packageIdentifierString instance FromJSON PackageIdentifier where parseJSON = withText "PackageIdentifier" $ \t -> case parsePackageIdentifier t of Left e -> fail $ show (e, t) Right x -> return x -- | Convert from a package identifier to a tuple. toTuple :: PackageIdentifier -> (PackageName,Version) toTuple (PackageIdentifier n v) = (n,v) -- | Convert from a tuple to a package identifier. fromTuple :: (PackageName,Version) -> PackageIdentifier fromTuple (n,v) = PackageIdentifier n v -- | A parser for a package-version pair. packageIdentifierParser :: Parser PackageIdentifier packageIdentifierParser = do name <- packageNameParser char '-' version <- versionParser return (PackageIdentifier name version) -- | Convenient way to parse a package identifier from a 'Text'. parsePackageIdentifier :: MonadThrow m => Text -> m PackageIdentifier parsePackageIdentifier x = go x where go = either (const (throwM (PackageIdentifierParseFail x))) return . parseOnly (packageIdentifierParser <* endOfInput) -- | Convenience function for parsing from a 'String'. parsePackageIdentifierFromString :: MonadThrow m => String -> m PackageIdentifier parsePackageIdentifierFromString = parsePackageIdentifier . T.pack -- | Get a string representation of the package identifier; name-ver. packageIdentifierString :: PackageIdentifier -> String packageIdentifierString (PackageIdentifier n v) = show n ++ "-" ++ show v -- | Get a Text representation of the package identifier; name-ver. packageIdentifierText :: PackageIdentifier -> Text packageIdentifierText = T.pack . packageIdentifierString stack-1.1.2/src/Stack/Types/PackageIndex.hs0000644000000000000000000000414712630674604016643 0ustar0000000000000000{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} module Stack.Types.PackageIndex ( PackageDownload (..) , PackageCache (..) , PackageCacheMap (..) ) where import Control.Monad (mzero) import Data.Aeson.Extended import qualified Data.Binary as Binary import Data.Binary.VersionTagged import Data.ByteString (ByteString) import Data.Int (Int64) import Data.Map (Map) import qualified Data.Map.Strict as Map import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) import Data.Word (Word64) import GHC.Generics (Generic) import Stack.Types.PackageIdentifier data PackageCache = PackageCache { pcOffset :: !Int64 -- ^ offset in bytes into the 00-index.tar file for the .cabal file contents , pcSize :: !Int64 -- ^ size in bytes of the .cabal file , pcDownload :: !(Maybe PackageDownload) } deriving (Generic) instance Binary PackageCache instance NFData PackageCache instance HasStructuralInfo PackageCache newtype PackageCacheMap = PackageCacheMap (Map PackageIdentifier PackageCache) deriving (Generic, Binary, NFData) instance HasStructuralInfo PackageCacheMap instance HasSemanticVersion PackageCacheMap data PackageDownload = PackageDownload { pdSHA512 :: !ByteString , pdUrl :: !ByteString , pdSize :: !Word64 } deriving (Show, Generic) instance Binary.Binary PackageDownload instance HasStructuralInfo PackageDownload instance NFData PackageDownload instance FromJSON PackageDownload where parseJSON = withObject "Package" $ \o -> do hashes <- o .: "package-hashes" sha512 <- maybe mzero return (Map.lookup ("SHA512" :: Text) hashes) locs <- o .: "package-locations" url <- case reverse locs of [] -> mzero x:_ -> return x size <- o .: "package-size" return PackageDownload { pdSHA512 = encodeUtf8 sha512 , pdUrl = encodeUtf8 url , pdSize = size } stack-1.1.2/src/Stack/Types/PackageName.hs0000644000000000000000000001341112670025006016434 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TupleSections #-} -- | Names for packages. module Stack.Types.PackageName (PackageName ,PackageNameParseFail(..) ,packageNameParser ,parsePackageName ,parsePackageNameFromString ,packageNameString ,packageNameText ,fromCabalPackageName ,toCabalPackageName ,parsePackageNameFromFilePath ,mkPackageName ,packageNameArgument) where import Control.Applicative import Control.DeepSeq import Control.Monad import Control.Monad.Catch import Data.Aeson.Extended import Data.Attoparsec.Text import Data.Attoparsec.Combinators import Data.Binary.VersionTagged (Binary, HasStructuralInfo) import Data.Data import Data.Hashable import Data.List (intercalate) import Data.Map (Map) import qualified Data.Map as Map import Data.Text (Text) import qualified Data.Text as T import Data.Text.Binary () import qualified Distribution.Package as Cabal import GHC.Generics import Language.Haskell.TH import Language.Haskell.TH.Syntax import Path import qualified Options.Applicative as O -- | A parse fail. data PackageNameParseFail = PackageNameParseFail Text | CabalFileNameParseFail FilePath | CabalFileNameInvalidPackageName FilePath deriving (Typeable) instance Exception PackageNameParseFail instance Show PackageNameParseFail where show (PackageNameParseFail bs) = "Invalid package name: " ++ show bs show (CabalFileNameParseFail fp) = "Invalid file path for cabal file, must have a .cabal extension: " ++ fp show (CabalFileNameInvalidPackageName fp) = "cabal file names must use valid package names followed by a .cabal extension, the following is invalid: " ++ fp -- | A package name. newtype PackageName = PackageName Text deriving (Eq,Ord,Typeable,Data,Generic,Hashable,Binary,NFData) instance Lift PackageName where lift (PackageName n) = appE (conE 'PackageName) (stringE (T.unpack n)) instance Show PackageName where show (PackageName n) = T.unpack n instance HasStructuralInfo PackageName instance ToJSON PackageName where toJSON = toJSON . packageNameText instance FromJSON PackageName where parseJSON j = do s <- parseJSON j case parsePackageNameFromString s of Nothing -> fail ("Couldn't parse package name: " ++ s) Just ver -> return ver -- | Attoparsec parser for a package name packageNameParser :: Parser PackageName packageNameParser = fmap (PackageName . T.pack . intercalate "-") (sepBy1 word (char '-')) where word = concat <$> sequence [many digit, pured letter, many (alternating letter digit)] -- | Make a package name. mkPackageName :: String -> Q Exp mkPackageName s = case parsePackageNameFromString s of Nothing -> error ("Invalid package name: " ++ show s) Just pn -> [|pn|] -- | Parse a package name from a 'Text'. parsePackageName :: MonadThrow m => Text -> m PackageName parsePackageName x = go x where go = either (const (throwM (PackageNameParseFail x))) return . parseOnly (packageNameParser <* endOfInput) -- | Parse a package name from a 'String'. parsePackageNameFromString :: MonadThrow m => String -> m PackageName parsePackageNameFromString = parsePackageName . T.pack -- | Produce a string representation of a package name. packageNameString :: PackageName -> String packageNameString (PackageName n) = T.unpack n -- | Produce a string representation of a package name. packageNameText :: PackageName -> Text packageNameText (PackageName n) = n -- | Convert from a Cabal package name. fromCabalPackageName :: Cabal.PackageName -> PackageName fromCabalPackageName (Cabal.PackageName name) = let !x = T.pack name in PackageName x -- | Convert to a Cabal package name. toCabalPackageName :: PackageName -> Cabal.PackageName toCabalPackageName (PackageName name) = let !x = T.unpack name in Cabal.PackageName x -- | Parse a package name from a file path. parsePackageNameFromFilePath :: MonadThrow m => Path a File -> m PackageName parsePackageNameFromFilePath fp = do base <- clean $ toFilePath $ filename fp case parsePackageNameFromString base of Nothing -> throwM $ CabalFileNameInvalidPackageName $ toFilePath fp Just x -> return x where clean = liftM reverse . strip . reverse strip ('l':'a':'b':'a':'c':'.':xs) = return xs strip _ = throwM (CabalFileNameParseFail (toFilePath fp)) instance ToJSON a => ToJSON (Map PackageName a) where toJSON = toJSON . Map.mapKeysWith const packageNameText instance FromJSON a => FromJSON (Map PackageName a) where parseJSON val = do m <- parseJSON val fmap Map.fromList $ mapM go $ Map.toList m where go (k, v) = fmap (, v) $ either (fail . show) return $ parsePackageNameFromString k -- | An argument which accepts a template name of the format -- @foo.hsfiles@. packageNameArgument :: O.Mod O.ArgumentFields PackageName -> O.Parser PackageName packageNameArgument = O.argument (do s <- O.str either O.readerError return (p s)) where p s = case parsePackageNameFromString s of Just x -> Right x Nothing -> Left $ unlines [ "Expected valid package name, but got: " ++ s , "Package names consist of one or more alphanumeric words separated by hyphens." , "To avoid ambiguity with version numbers, each of these words must contain at least one letter." ] stack-1.1.2/src/Stack/Types/Sig.hs0000644000000000000000000000570512711761455015044 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-| Module : Stack.Types.Sig Description : Signature Types Copyright : (c) FPComplete.com, 2015 License : BSD3 Maintainer : Tim Dysinger Stability : experimental Portability : POSIX -} module Stack.Types.Sig (Signature(..), Fingerprint, mkFingerprint, SigException(..)) where import Prelude () import Prelude.Compat import Control.Exception (Exception) import Data.Aeson (Value(..), ToJSON(..), FromJSON(..)) import Data.ByteString (ByteString) import qualified Data.ByteString as SB import Data.Char (isHexDigit) import Data.Monoid ((<>)) import Data.String (IsString(..)) import Data.Text (Text) import qualified Data.Text as T import Data.Typeable (Typeable) import Stack.Types.PackageName -- | A GPG signature. newtype Signature = Signature ByteString deriving (Ord,Eq) instance Show Signature where show (Signature s) = "Signature " ++ (if SB.length s > 140 then show (SB.take 140 s) ++ "..." else show (SB.take 140 s)) -- | The GPG fingerprint. newtype Fingerprint = Fingerprint Text deriving (Eq,Ord) mkFingerprint :: Text -> Fingerprint mkFingerprint = Fingerprint . hexText hexText :: Text -> Text hexText = T.toUpper . T.dropWhile (not . isHexDigit) instance Show Fingerprint where show (Fingerprint hex) = T.unpack (hexText hex) instance FromJSON Fingerprint where parseJSON j = Fingerprint . hexText <$> parseJSON j instance ToJSON Fingerprint where toJSON (Fingerprint hex) = String (hexText hex) instance IsString Fingerprint where fromString = Fingerprint . hexText . T.pack instance FromJSON (Aeson PackageName) where parseJSON j = do s <- parseJSON j case parsePackageName s of Just name -> return (Aeson name) Nothing -> fail ("Invalid package name: " <> T.unpack s) -- | Handy wrapper for orphan instances. newtype Aeson a = Aeson { _unAeson :: a } deriving (Ord,Eq) -- | Exceptions data SigException = GPGFingerprintException String | GPGNotFoundException | GPGSignException String | GPGVerifyException String | SigInvalidSDistTarBall | SigNoProjectRootException | SigServiceException String deriving (Typeable) instance Exception SigException instance Show SigException where show (GPGFingerprintException e) = "Error extracting a GPG fingerprint " <> e show GPGNotFoundException = "Unable to find gpg2 or gpg executable" show (GPGSignException e) = "Error signing with GPG " <> e show (GPGVerifyException e) = "Error verifying with GPG " <> e show SigNoProjectRootException = "Missing Project Root" show SigInvalidSDistTarBall = "Invalid sdist tarball" show (SigServiceException e) = "Error with the Signature Service " <> e stack-1.1.2/src/Stack/Types/StackT.hs0000644000000000000000000003316412717707441015514 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | The monad used for the command-line executable @stack@. module Stack.Types.StackT (StackT ,StackLoggingT ,runStackT ,runStackTGlobal ,runStackLoggingT ,runStackLoggingTGlobal ,runInnerStackT ,runInnerStackLoggingT ,newTLSManager ,logSticky ,logStickyDone) where import Control.Applicative import Control.Concurrent.MVar import Control.Monad import Control.Monad.Base import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader import Control.Monad.Trans.Control import qualified Data.ByteString.Char8 as S8 import Data.Char import Data.Maybe import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T import qualified Data.Text.IO as T import Data.Time import GHC.Foreign (withCString, peekCString) import Language.Haskell.TH import Network.HTTP.Client.Conduit (HasHttpManager(..)) import Network.HTTP.Conduit import Prelude -- Fix AMP warning import Stack.Types.Internal import Stack.Types.Config (GlobalOpts (..)) import System.IO import System.Log.FastLogger #ifndef MIN_VERSION_time #define MIN_VERSION_time(x, y, z) 0 #endif #if !MIN_VERSION_time(1, 5, 0) import System.Locale #endif -------------------------------------------------------------------------------- -- Main StackT monad transformer -- | The monad used for the executable @stack@. newtype StackT config m a = StackT {unStackT :: ReaderT (Env config) m a} deriving (Functor,Applicative,Monad,MonadIO,MonadReader (Env config),MonadThrow,MonadCatch,MonadMask,MonadTrans) deriving instance (MonadBase b m) => MonadBase b (StackT config m) instance MonadBaseControl b m => MonadBaseControl b (StackT config m) where type StM (StackT config m) a = ComposeSt (StackT config) m a liftBaseWith = defaultLiftBaseWith restoreM = defaultRestoreM instance MonadTransControl (StackT config) where type StT (StackT config) a = StT (ReaderT (Env config)) a liftWith = defaultLiftWith StackT unStackT restoreT = defaultRestoreT StackT -- | Takes the configured log level into account. instance (MonadIO m) => MonadLogger (StackT config m) where monadLoggerLog = stickyLoggerFunc -- | Run a Stack action, using global options. runStackTGlobal :: (MonadIO m) => Manager -> config -> GlobalOpts -> StackT config m a -> m a runStackTGlobal manager config GlobalOpts{..} = runStackT manager globalLogLevel config globalTerminal (isJust globalReExecVersion) -- | Run a Stack action. runStackT :: (MonadIO m) => Manager -> LogLevel -> config -> Bool -> Bool -> StackT config m a -> m a runStackT manager logLevel config terminal reExec m = do canUseUnicode <- liftIO getCanUseUnicode withSticky terminal (\sticky -> runReaderT (unStackT m) (Env config logLevel terminal reExec manager sticky canUseUnicode)) -- | Taken from GHC: determine if we should use Unicode syntax getCanUseUnicode :: IO Bool getCanUseUnicode = do let enc = localeEncoding str = "\x2018\x2019" test = withCString enc str $ \cstr -> do str' <- peekCString enc cstr return (str == str') test `catchIOError` \_ -> return False -------------------------------------------------------------------------------- -- Logging only StackLoggingT monad transformer -- | Monadic environment for 'StackLoggingT'. data LoggingEnv = LoggingEnv { lenvLogLevel :: !LogLevel , lenvTerminal :: !Bool , lenvReExec :: !Bool , lenvManager :: !Manager , lenvSticky :: !Sticky , lenvSupportsUnicode :: !Bool } -- | The monad used for logging in the executable @stack@ before -- anything has been initialized. newtype StackLoggingT m a = StackLoggingT { unStackLoggingT :: ReaderT LoggingEnv m a } deriving (Functor,Applicative,Monad,MonadIO,MonadThrow,MonadReader LoggingEnv,MonadCatch,MonadMask,MonadTrans) deriving instance (MonadBase b m) => MonadBase b (StackLoggingT m) instance MonadBaseControl b m => MonadBaseControl b (StackLoggingT m) where type StM (StackLoggingT m) a = ComposeSt StackLoggingT m a liftBaseWith = defaultLiftBaseWith restoreM = defaultRestoreM instance MonadTransControl StackLoggingT where type StT StackLoggingT a = StT (ReaderT LoggingEnv) a liftWith = defaultLiftWith StackLoggingT unStackLoggingT restoreT = defaultRestoreT StackLoggingT -- | Takes the configured log level into account. instance (MonadIO m) => MonadLogger (StackLoggingT m) where monadLoggerLog = stickyLoggerFunc instance HasSticky LoggingEnv where getSticky = lenvSticky instance HasLogLevel LoggingEnv where getLogLevel = lenvLogLevel instance HasHttpManager LoggingEnv where getHttpManager = lenvManager instance HasTerminal LoggingEnv where getTerminal = lenvTerminal instance HasReExec LoggingEnv where getReExec = lenvReExec instance HasSupportsUnicode LoggingEnv where getSupportsUnicode = lenvSupportsUnicode runInnerStackT :: (HasHttpManager r, HasLogLevel r, HasTerminal r, HasReExec r, MonadReader r m, MonadIO m) => config -> StackT config IO a -> m a runInnerStackT config inner = do manager <- asks getHttpManager logLevel <- asks getLogLevel terminal <- asks getTerminal reExec <- asks getReExec liftIO $ runStackT manager logLevel config terminal reExec inner runInnerStackLoggingT :: (HasHttpManager r, HasLogLevel r, HasTerminal r, HasReExec r, MonadReader r m, MonadIO m) => StackLoggingT IO a -> m a runInnerStackLoggingT inner = do manager <- asks getHttpManager logLevel <- asks getLogLevel terminal <- asks getTerminal reExec <- asks getReExec liftIO $ runStackLoggingT manager logLevel terminal reExec inner -- | Run the logging monad, using global options. runStackLoggingTGlobal :: MonadIO m => Manager -> GlobalOpts -> StackLoggingT m a -> m a runStackLoggingTGlobal manager GlobalOpts{..} = runStackLoggingT manager globalLogLevel globalTerminal (isJust globalReExecVersion) -- | Run the logging monad. runStackLoggingT :: MonadIO m => Manager -> LogLevel -> Bool -> Bool -> StackLoggingT m a -> m a runStackLoggingT manager logLevel terminal reExec m = do canUseUnicode <- liftIO getCanUseUnicode withSticky terminal (\sticky -> runReaderT (unStackLoggingT m) LoggingEnv { lenvLogLevel = logLevel , lenvManager = manager , lenvSticky = sticky , lenvTerminal = terminal , lenvReExec = reExec , lenvSupportsUnicode = canUseUnicode }) -- | Convenience for getting a 'Manager' newTLSManager :: MonadIO m => m Manager newTLSManager = liftIO $ newManager tlsManagerSettings -------------------------------------------------------------------------------- -- Logging functionality stickyLoggerFunc :: (HasSticky r, HasLogLevel r, HasSupportsUnicode r, ToLogStr msg, MonadReader r m, MonadIO m) => Loc -> LogSource -> LogLevel -> msg -> m () stickyLoggerFunc loc src level msg = do Sticky mref <- asks getSticky case mref of Nothing -> loggerFunc out loc src (case level of LevelOther "sticky-done" -> LevelInfo LevelOther "sticky" -> LevelInfo _ -> level) msg Just ref -> do sticky <- liftIO (takeMVar ref) let backSpaceChar = '\8' repeating = S8.replicate (maybe 0 T.length sticky) clear = liftIO (S8.hPutStr out (repeating backSpaceChar <> repeating ' ' <> repeating backSpaceChar)) maxLogLevel <- asks getLogLevel -- Convert some GHC-generated Unicode characters as necessary supportsUnicode <- asks getSupportsUnicode let msgText | supportsUnicode = msgTextRaw | otherwise = T.map replaceUnicode msgTextRaw newState <- case level of LevelOther "sticky-done" -> do clear liftIO (T.hPutStrLn out msgText >> hFlush out) return Nothing LevelOther "sticky" -> do clear liftIO (T.hPutStr out msgText >> hFlush out) return (Just msgText) _ | level >= maxLogLevel -> do clear loggerFunc out loc src level $ toLogStr msgText case sticky of Nothing -> return Nothing Just line -> do liftIO (T.hPutStr out line >> hFlush out) return sticky | otherwise -> return sticky liftIO (putMVar ref newState) where out = stderr msgTextRaw = T.decodeUtf8With T.lenientDecode msgBytes msgBytes = fromLogStr (toLogStr msg) -- | Replace Unicode characters with non-Unicode equivalents replaceUnicode :: Char -> Char replaceUnicode '\x2018' = '`' replaceUnicode '\x2019' = '\'' replaceUnicode c = c -- | Logging function takes the log level into account. loggerFunc :: (MonadIO m,ToLogStr msg,MonadReader r m,HasLogLevel r) => Handle -> Loc -> Text -> LogLevel -> msg -> m () loggerFunc outputChannel loc _src level msg = do maxLogLevel <- asks getLogLevel when (level >= maxLogLevel) (liftIO (do out <- getOutput maxLogLevel T.hPutStrLn outputChannel out)) where getOutput maxLogLevel = do timestamp <- getTimestamp l <- getLevel lc <- getLoc return (T.pack timestamp <> T.pack l <> T.decodeUtf8 (fromLogStr (toLogStr msg)) <> T.pack lc) where getTimestamp | maxLogLevel <= LevelDebug = do now <- getZonedTime return (formatTime' now ++ ": ") | otherwise = return "" where formatTime' = take timestampLength . formatTime defaultTimeLocale "%F %T.%q" getLevel | maxLogLevel <= LevelDebug = return ("[" ++ map toLower (drop 5 (show level)) ++ "] ") | otherwise = return "" getLoc | maxLogLevel <= LevelDebug = return (" @(" ++ fileLocStr ++ ")") | otherwise = return "" fileLocStr = loc_package loc ++ ':' : loc_module loc ++ ' ' : loc_filename loc ++ ':' : line loc ++ ':' : char loc where line = show . fst . loc_start char = show . snd . loc_start -- | The length of a timestamp in the format "YYYY-MM-DD hh:mm:ss.μμμμμμ". -- This definition is top-level in order to avoid multiple reevaluation at runtime. timestampLength :: Int timestampLength = length (formatTime defaultTimeLocale "%F %T.000000" (UTCTime (ModifiedJulianDay 0) 0)) -- | With a sticky state, do the thing. withSticky :: (MonadIO m) => Bool -> (Sticky -> m b) -> m b withSticky terminal m = if terminal then do state <- liftIO (newMVar Nothing) originalMode <- liftIO (hGetBuffering stdout) liftIO (hSetBuffering stdout NoBuffering) a <- m (Sticky (Just state)) state' <- liftIO (takeMVar state) liftIO (when (isJust state') (S8.putStr "\n")) liftIO (hSetBuffering stdout originalMode) return a else m (Sticky Nothing) -- | Write a "sticky" line to the terminal. Any subsequent lines will -- overwrite this one, and that same line will be repeated below -- again. In other words, the line sticks at the bottom of the output -- forever. Running this function again will replace the sticky line -- with a new sticky line. When you want to get rid of the sticky -- line, run 'logStickyDone'. -- logSticky :: Q Exp logSticky = logOther "sticky" -- | This will print out the given message with a newline and disable -- any further stickiness of the line until a new call to 'logSticky' -- happens. -- -- It might be better at some point to have a 'runSticky' function -- that encompasses the logSticky->logStickyDone pairing. logStickyDone :: Q Exp logStickyDone = logOther "sticky-done" stack-1.1.2/src/Stack/Types/TemplateName.hs0000644000000000000000000001034512707670645016677 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Template name handling. module Stack.Types.TemplateName where import Control.Error.Safe (justErr) import Control.Applicative import Data.Aeson.Extended (FromJSON, withText, parseJSON) import Data.Aeson.Types (typeMismatch) import Data.Foldable (asum) import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import Data.Yaml (Value(Object), (.:?)) import Language.Haskell.TH import Network.HTTP.Client (parseUrl) import qualified Options.Applicative as O import Path import Path.Internal import Prelude -- | A template name. data TemplateName = TemplateName !Text !TemplatePath deriving (Ord,Eq,Show) data TemplatePath = AbsPath (Path Abs File) -- ^ an absolute path on the filesystem | RelPath (Path Rel File) -- ^ a relative path on the filesystem, or relative to -- the template repository | UrlPath String -- ^ a full URL deriving (Eq, Ord, Show) instance FromJSON TemplateName where parseJSON = withText "TemplateName" $ either fail return . parseTemplateNameFromString . T.unpack data TemplateInfo = TemplateInfo { author :: Maybe Text , description :: Maybe Text } deriving (Eq, Ord, Show) instance FromJSON TemplateInfo where parseJSON (Object v) = TemplateInfo <$> v .:? "author" <*> v .:? "description" parseJSON invalid = typeMismatch "Template Info" invalid -- | An argument which accepts a template name of the format -- @foo.hsfiles@ or @foo@, ultimately normalized to @foo@. templateNameArgument :: O.Mod O.ArgumentFields TemplateName -> O.Parser TemplateName templateNameArgument = O.argument (do string <- O.str either O.readerError return (parseTemplateNameFromString string)) -- | An argument which accepts a @key:value@ pair for specifying parameters. templateParamArgument :: O.Mod O.OptionFields (Text,Text) -> O.Parser (Text,Text) templateParamArgument = O.option (do string <- O.str either O.readerError return (parsePair string)) where parsePair :: String -> Either String (Text, Text) parsePair s = case break (==':') s of (key,':':value@(_:_)) -> Right (T.pack key, T.pack value) _ -> Left ("Expected key:value format for argument: " <> s) -- | Parse a template name from a string. parseTemplateNameFromString :: String -> Either String TemplateName parseTemplateNameFromString fname = case T.stripSuffix ".hsfiles" (T.pack fname) of Nothing -> parseValidFile (T.pack fname) (fname <> ".hsfiles") fname Just prefix -> parseValidFile prefix fname fname where parseValidFile prefix hsf orig = justErr expected $ asum (validParses prefix hsf orig) validParses prefix hsf orig = -- NOTE: order is important [ TemplateName (T.pack orig) . UrlPath <$> (parseUrl orig *> Just orig) , TemplateName prefix . AbsPath <$> parseAbsFile hsf , TemplateName prefix . RelPath <$> parseRelFile hsf ] expected = "Expected a template like: foo or foo.hsfiles or\ \ https://example.com/foo.hsfiles" -- | Make a template name. mkTemplateName :: String -> Q Exp mkTemplateName s = case parseTemplateNameFromString s of Left{} -> error ("Invalid template name: " ++ show s) Right (TemplateName (T.unpack -> prefix) p) -> [|TemplateName (T.pack prefix) $(pn)|] where pn = case p of AbsPath (Path fp) -> [|AbsPath (Path fp)|] RelPath (Path fp) -> [|RelPath (Path fp)|] UrlPath fp -> [|UrlPath fp|] -- | Get a text representation of the template name. templateName :: TemplateName -> Text templateName (TemplateName prefix _) = prefix -- | Get the path of the template. templatePath :: TemplateName -> TemplatePath templatePath (TemplateName _ fp) = fp stack-1.1.2/src/Stack/Types/Version.hs0000644000000000000000000001722512717707441015750 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} -- | Versions for packages. module Stack.Types.Version (Version ,Cabal.VersionRange -- TODO in the future should have a newtype wrapper ,IntersectingVersionRange(..) ,VersionCheck(..) ,versionParser ,parseVersion ,parseVersionFromString ,versionString ,versionText ,toCabalVersion ,fromCabalVersion ,mkVersion ,versionRangeText ,withinRange ,Stack.Types.Version.intersectVersionRanges ,toMajorVersion ,latestApplicableVersion ,checkVersion ,nextMajorVersion) where import Control.Applicative import Control.DeepSeq import Control.Monad.Catch import Data.Aeson.Extended import Data.Attoparsec.Text import Data.Binary.VersionTagged (Binary, HasStructuralInfo) import Data.Data import Data.Hashable import Data.List import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (listToMaybe) import Data.Monoid import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import Data.Text.Binary () import Data.Vector.Binary () import Data.Vector.Unboxed (Vector) import qualified Data.Vector.Unboxed as V import Data.Word import Distribution.Text (disp) import qualified Distribution.Version as Cabal import GHC.Generics import Language.Haskell.TH import Language.Haskell.TH.Syntax import Prelude -- Fix warning: Word in Prelude from base-4.8. import Text.PrettyPrint (render) -- | A parse fail. data VersionParseFail = VersionParseFail Text deriving (Typeable) instance Exception VersionParseFail instance Show VersionParseFail where show (VersionParseFail bs) = "Invalid version: " ++ show bs -- | A package version. newtype Version = Version {unVersion :: Vector Word} deriving (Eq,Ord,Typeable,Data,Generic,Binary,NFData) instance HasStructuralInfo Version instance Hashable Version where hashWithSalt i = hashWithSalt i . V.toList . unVersion instance Lift Version where lift (Version n) = appE (conE 'Version) (appE (varE 'V.fromList) (listE (map (litE . IntegerL . fromIntegral) (V.toList n)))) instance Show Version where show (Version v) = intercalate "." (map show (V.toList v)) instance ToJSON Version where toJSON = toJSON . versionText instance FromJSON Version where parseJSON j = do s <- parseJSON j case parseVersionFromString s of Nothing -> fail ("Couldn't parse package version: " ++ s) Just ver -> return ver instance FromJSON a => FromJSON (Map Version a) where parseJSON val = do m <- parseJSON val fmap Map.fromList $ mapM go $ Map.toList m where go (k, v) = do k' <- either (fail . show) return $ parseVersionFromString k return (k', v) newtype IntersectingVersionRange = IntersectingVersionRange { getIntersectingVersionRange :: Cabal.VersionRange } deriving Show instance Monoid IntersectingVersionRange where mempty = IntersectingVersionRange Cabal.anyVersion mappend (IntersectingVersionRange l) (IntersectingVersionRange r) = IntersectingVersionRange (l `Cabal.intersectVersionRanges` r) -- | Attoparsec parser for a package version. versionParser :: Parser Version versionParser = do ls <- ((:) <$> num <*> many num') let !v = V.fromList ls return (Version v) where num = decimal num' = point *> num point = satisfy (== '.') -- | Convenient way to parse a package version from a 'Text'. parseVersion :: MonadThrow m => Text -> m Version parseVersion x = go x where go = either (const (throwM (VersionParseFail x))) return . parseOnly (versionParser <* endOfInput) -- | Migration function. parseVersionFromString :: MonadThrow m => String -> m Version parseVersionFromString = parseVersion . T.pack -- | Get a string representation of a package version. versionString :: Version -> String versionString (Version v) = intercalate "." (map show (V.toList v)) -- | Get a string representation of a package version. versionText :: Version -> Text versionText (Version v) = T.intercalate "." (map (T.pack . show) (V.toList v)) -- | Convert to a Cabal version. toCabalVersion :: Version -> Cabal.Version toCabalVersion (Version v) = Cabal.Version (map fromIntegral (V.toList v)) [] -- | Convert from a Cabal version. fromCabalVersion :: Cabal.Version -> Version fromCabalVersion (Cabal.Version vs _) = let !v = V.fromList (map fromIntegral vs) in Version v -- | Make a package version. mkVersion :: String -> Q Exp mkVersion s = case parseVersionFromString s of Nothing -> error ("Invalid package version: " ++ show s) Just pn -> [|pn|] -- | Display a version range versionRangeText :: Cabal.VersionRange -> Text versionRangeText = T.pack . render . disp -- | Check if a version is within a version range. withinRange :: Version -> Cabal.VersionRange -> Bool withinRange v r = toCabalVersion v `Cabal.withinRange` r -- | A modified intersection which also simplifies, for better display. intersectVersionRanges :: Cabal.VersionRange -> Cabal.VersionRange -> Cabal.VersionRange intersectVersionRanges x y = Cabal.simplifyVersionRange $ Cabal.intersectVersionRanges x y -- | Returns the first two components, defaulting to 0 if not present toMajorVersion :: Version -> Version toMajorVersion (Version v) = case V.length v of 0 -> Version (V.fromList [0, 0]) 1 -> Version (V.fromList [V.head v, 0]) _ -> Version (V.fromList [V.head v, v V.! 1]) -- | Given a version range and a set of versions, find the latest version from -- the set that is within the range. latestApplicableVersion :: Cabal.VersionRange -> Set Version -> Maybe Version latestApplicableVersion r = listToMaybe . filter (`withinRange` r) . Set.toDescList -- | Get the next major version number for the given version nextMajorVersion :: Version -> Version nextMajorVersion (Version v) = case V.length v of 0 -> Version (V.fromList [0, 1]) 1 -> Version (V.fromList [V.head v, 1]) _ -> Version (V.fromList [V.head v, (v V.! 1) + 1]) data VersionCheck = MatchMinor | MatchExact | NewerMinor deriving (Show, Eq, Ord) instance ToJSON VersionCheck where toJSON MatchMinor = String "match-minor" toJSON MatchExact = String "match-exact" toJSON NewerMinor = String "newer-minor" instance FromJSON VersionCheck where parseJSON = withText expected $ \t -> case t of "match-minor" -> return MatchMinor "match-exact" -> return MatchExact "newer-minor" -> return NewerMinor _ -> fail ("Expected " ++ expected ++ ", but got " ++ show t) where expected = "VersionCheck value (match-minor, match-exact, or newer-minor)" checkVersion :: VersionCheck -> Version -> Version -> Bool checkVersion check (Version wanted) (Version actual) = case check of MatchMinor -> V.and (V.take 3 matching) MatchExact -> V.length wanted == V.length actual && V.and matching NewerMinor -> V.and (V.take 2 matching) && newerMinor where matching = V.zipWith (==) wanted actual newerMinor = case (wanted V.!? 2, actual V.!? 2) of (Nothing, _) -> True (Just _, Nothing) -> False (Just w, Just a) -> a >= w stack-1.1.2/src/Stack/Upgrade.hs0000644000000000000000000001142512717707441014602 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Stack.Upgrade (upgrade) where import Control.Monad (when) import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (MonadReader) import Control.Monad.Trans.Control import Data.Foldable (forM_) import qualified Data.Map as Map import Data.Maybe (isNothing) import Data.Monoid.Extra import qualified Data.Text as T import Lens.Micro (set) import Network.HTTP.Client.Conduit (HasHttpManager) import Path import Path.IO import qualified Paths_stack as Paths import Stack.Build import Stack.Config import Stack.Fetch import Stack.PackageIndex import Stack.Setup import Stack.Types import Stack.Types.Internal import Stack.Types.StackT import System.Process (readProcess) import System.Process.Run upgrade :: (MonadIO m, MonadMask m, MonadReader env m, HasConfig env, HasHttpManager env, MonadLogger m, HasTerminal env, HasReExec env, HasLogLevel env, MonadBaseControl IO m) => ConfigMonoid -> Maybe String -- ^ git repository to use -> Maybe AbstractResolver -> Maybe String -- ^ git hash at time of building, if known -> m () upgrade gConfigMonoid gitRepo mresolver builtHash = withSystemTempDir "stack-upgrade" $ \tmp -> do menv <- getMinimalEnvOverride mdir <- case gitRepo of Just repo -> do remote <- liftIO $ readProcess "git" ["ls-remote", repo, "master"] [] let latestCommit = head . words $ remote when (isNothing builtHash) $ $logWarn $ "Information about the commit this version of stack was " <> "built from is not available due to how it was built. " <> "Will continue by assuming an upgrade is needed " <> "because we have no information to the contrary." if builtHash == Just latestCommit then do $logInfo "Already up-to-date, no upgrade required" return Nothing else do $logInfo "Cloning stack" -- NOTE: "--recursive" was added after v1.0.0 (and before the -- next release). This means that we can't use submodules in -- the stack repo until we're comfortable with "stack upgrade -- --git" not working for earlier versions. let args = [ "clone", repo , "stack", "--depth", "1", "--recursive"] runCmd (Cmd (Just tmp) "git" menv args) Nothing return $ Just $ tmp $(mkRelDir "stack") Nothing -> do updateAllIndices menv caches <- getPackageCaches let latest = Map.fromListWith max $ map toTuple $ Map.keys -- Mistaken upload to Hackage, just ignore it $ Map.delete (PackageIdentifier $(mkPackageName "stack") $(mkVersion "9.9.9")) caches case Map.lookup $(mkPackageName "stack") latest of Nothing -> error "No stack found in package indices" Just version | version <= fromCabalVersion Paths.version -> do $logInfo "Already at latest version, no upgrade required" return Nothing Just version -> do let ident = PackageIdentifier $(mkPackageName "stack") version paths <- unpackPackageIdents menv tmp Nothing -- accept latest cabal revision by not supplying a Git SHA $ Map.singleton ident Nothing case Map.lookup ident paths of Nothing -> error "Stack.Upgrade.upgrade: invariant violated, unpacked directory not found" Just path -> return $ Just path forM_ mdir $ \dir -> do lc <- loadConfig gConfigMonoid mresolver (Just $ dir $(mkRelFile "stack.yaml")) bconfig <- lcLoadBuildConfig lc Nothing envConfig1 <- runInnerStackT bconfig $ setupEnv $ Just $ "Try rerunning with --install-ghc to install the correct GHC into " <> T.pack (toFilePath (configLocalPrograms (getConfig bconfig))) runInnerStackT (set (envConfigBuildOpts.buildOptsInstallExes) True envConfig1) $ build (const $ return ()) Nothing defaultBuildOptsCLI { boptsCLITargets = ["stack"] } stack-1.1.2/src/Stack/Upload.hs0000644000000000000000000002605112644245454014440 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Provide ability to upload tarballs to Hackage. module Stack.Upload ( -- * Upload nopUploader , mkUploader , Uploader , upload , uploadBytes , UploadSettings , defaultUploadSettings , setUploadUrl , setGetManager , setCredsSource , setSaveCreds -- * Credentials , HackageCreds , loadCreds , saveCreds , FromFile -- ** Credentials source , HackageCredsSource , fromAnywhere , fromPrompt , fromFile , fromMemory ) where import Control.Applicative import Control.Exception (bracket) import qualified Control.Exception as E import Control.Monad (when, unless) import Data.Aeson (FromJSON (..), ToJSON (..), eitherDecode', encode, object, withObject, (.:), (.=)) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy as L import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import qualified Data.Text.IO as TIO import Data.Typeable (Typeable) import Network.HTTP.Client (BodyReader, Manager, Response, RequestBody(RequestBodyLBS), applyBasicAuth, brRead, checkStatus, newManager, parseUrl, requestHeaders, responseBody, responseStatus, withResponse) import Network.HTTP.Client.MultipartFormData (formDataBody, partFileRequestBody) import Network.HTTP.Client.TLS (tlsManagerSettings) import Network.HTTP.Types (statusCode) import Path (toFilePath) import Prelude -- Fix redundant import warnings import Stack.Types import System.Directory (createDirectoryIfMissing, removeFile) import System.FilePath ((), takeFileName) import System.IO (hFlush, hGetEcho, hSetEcho, stdin, stdout) -- | Username and password to log into Hackage. -- -- Since 0.1.0.0 data HackageCreds = HackageCreds { hcUsername :: !Text , hcPassword :: !Text } deriving Show instance ToJSON HackageCreds where toJSON (HackageCreds u p) = object [ "username" .= u , "password" .= p ] instance FromJSON HackageCreds where parseJSON = withObject "HackageCreds" $ \o -> HackageCreds <$> o .: "username" <*> o .: "password" -- | A source for getting Hackage credentials. -- -- Since 0.1.0.0 newtype HackageCredsSource = HackageCredsSource { getCreds :: IO (HackageCreds, FromFile) } -- | Whether the Hackage credentials were loaded from a file. -- -- This information is useful since, typically, you only want to save the -- credentials to a file if it wasn't already loaded from there. -- -- Since 0.1.0.0 type FromFile = Bool -- | Load Hackage credentials from the given source. -- -- Since 0.1.0.0 loadCreds :: HackageCredsSource -> IO (HackageCreds, FromFile) loadCreds = getCreds -- | Save the given credentials to the credentials file. -- -- Since 0.1.0.0 saveCreds :: Config -> HackageCreds -> IO () saveCreds config creds = do fp <- credsFile config L.writeFile fp $ encode creds -- | Load the Hackage credentials from the prompt, asking the user to type them -- in. -- -- Since 0.1.0.0 fromPrompt :: HackageCredsSource fromPrompt = HackageCredsSource $ do putStr "Hackage username: " hFlush stdout username <- TIO.getLine password <- promptPassword return (HackageCreds { hcUsername = username , hcPassword = password }, False) credsFile :: Config -> IO FilePath credsFile config = do let dir = toFilePath (configStackRoot config) "upload" createDirectoryIfMissing True dir return $ dir "credentials.json" -- | Load the Hackage credentials from the JSON config file. -- -- Since 0.1.0.0 fromFile :: Config -> HackageCredsSource fromFile config = HackageCredsSource $ do fp <- credsFile config lbs <- L.readFile fp case eitherDecode' lbs of Left e -> E.throwIO $ Couldn'tParseJSON fp e Right creds -> return (creds, True) -- | Load the Hackage credentials from the given arguments. -- -- Since 0.1.0.0 fromMemory :: Text -> Text -> HackageCredsSource fromMemory u p = HackageCredsSource $ return (HackageCreds { hcUsername = u , hcPassword = p }, False) data HackageCredsExceptions = Couldn'tParseJSON FilePath String deriving (Show, Typeable) instance E.Exception HackageCredsExceptions -- | Try to load the credentials from the config file. If that fails, ask the -- user to enter them. -- -- Since 0.1.0.0 fromAnywhere :: Config -> HackageCredsSource fromAnywhere config = HackageCredsSource $ getCreds (fromFile config) `E.catches` [ E.Handler $ \(_ :: E.IOException) -> getCreds fromPrompt , E.Handler $ \(_ :: HackageCredsExceptions) -> getCreds fromPrompt ] -- | Lifted from cabal-install, Distribution.Client.Upload promptPassword :: IO Text promptPassword = do putStr "Hackage password: " hFlush stdout -- save/restore the terminal echoing status passwd <- bracket (hGetEcho stdin) (hSetEcho stdin) $ \_ -> do hSetEcho stdin False -- no echoing for entering the password fmap T.pack getLine putStrLn "" return passwd nopUploader :: Config -> UploadSettings -> IO Uploader nopUploader _ _ = return (Uploader nop) where nop :: String -> L.ByteString -> IO () nop _ _ = return () -- | Turn the given settings into an @Uploader@. -- -- Since 0.1.0.0 mkUploader :: Config -> UploadSettings -> IO Uploader mkUploader config us = do manager <- usGetManager us (creds, fromFile') <- loadCreds $ usCredsSource us config when (not fromFile' && usSaveCreds us) $ saveCreds config creds req0 <- parseUrl $ usUploadUrl us let req1 = req0 { requestHeaders = [("Accept", "text/plain")] , checkStatus = \_ _ _ -> Nothing } return Uploader { upload_ = \tarName bytes -> do let formData = [partFileRequestBody "package" tarName (RequestBodyLBS bytes)] req2 <- formDataBody formData req1 let req3 = applyBasicAuth (encodeUtf8 $ hcUsername creds) (encodeUtf8 $ hcPassword creds) req2 putStr $ "Uploading " ++ tarName ++ "... " hFlush stdout withResponse req3 manager $ \res -> case statusCode $ responseStatus res of 200 -> putStrLn "done!" 401 -> do putStrLn "authentication failure" cfp <- credsFile config handleIO (const $ return ()) (removeFile cfp) error "Authentication failure uploading to server" 403 -> do putStrLn "forbidden upload" putStrLn "Usually means: you've already uploaded this package/version combination" putStrLn "Ignoring error and continuing, full message from Hackage below:\n" printBody res 503 -> do putStrLn "service unavailable" putStrLn "This error some times gets sent even though the upload succeeded" putStrLn "Check on Hackage to see if your pacakge is present" printBody res code -> do putStrLn $ "unhandled status code: " ++ show code printBody res error $ "Upload failed on " ++ tarName } printBody :: Response BodyReader -> IO () printBody res = loop where loop = do bs <- brRead $ responseBody res unless (S.null bs) $ do S.hPut stdout bs loop -- | The computed value from a @UploadSettings@. -- -- Typically, you want to use this with 'upload'. -- -- Since 0.1.0.0 data Uploader = Uploader { upload_ :: !(String -> L.ByteString -> IO ()) } -- | Upload a single tarball with the given @Uploader@. -- -- Since 0.1.0.0 upload :: Uploader -> FilePath -> IO () upload uploader fp = upload_ uploader (takeFileName fp) =<< L.readFile fp -- | Upload a single tarball with the given @Uploader@. Instead of -- sending a file like 'upload', this sends a lazy bytestring. -- -- Since 0.1.2.1 uploadBytes :: Uploader -> String -> L.ByteString -> IO () uploadBytes = upload_ -- | Settings for creating an @Uploader@. -- -- Since 0.1.0.0 data UploadSettings = UploadSettings { usUploadUrl :: !String , usGetManager :: !(IO Manager) , usCredsSource :: !(Config -> HackageCredsSource) , usSaveCreds :: !Bool } -- | Default value for @UploadSettings@. -- -- Use setter functions to change defaults. -- -- Since 0.1.0.0 defaultUploadSettings :: UploadSettings defaultUploadSettings = UploadSettings { usUploadUrl = "https://hackage.haskell.org/packages/" , usGetManager = newManager tlsManagerSettings , usCredsSource = fromAnywhere , usSaveCreds = True } -- | Change the upload URL. -- -- Default: "https://hackage.haskell.org/packages/" -- -- Since 0.1.0.0 setUploadUrl :: String -> UploadSettings -> UploadSettings setUploadUrl x us = us { usUploadUrl = x } -- | How to get an HTTP connection manager. -- -- Default: @newManager tlsManagerSettings@ -- -- Since 0.1.0.0 setGetManager :: IO Manager -> UploadSettings -> UploadSettings setGetManager x us = us { usGetManager = x } -- | How to get the Hackage credentials. -- -- Default: @fromAnywhere@ -- -- Since 0.1.0.0 setCredsSource :: (Config -> HackageCredsSource) -> UploadSettings -> UploadSettings setCredsSource x us = us { usCredsSource = x } -- | Save new credentials to the config file. -- -- Default: @True@ -- -- Since 0.1.0.0 setSaveCreds :: Bool -> UploadSettings -> UploadSettings setSaveCreds x us = us { usSaveCreds = x } handleIO :: (E.IOException -> IO a) -> IO a -> IO a handleIO = E.handle stack-1.1.2/src/System/Process/Log.hs0000644000000000000000000000327412701273661015567 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- | Separate module because TH. module System.Process.Log (logCreateProcess ,logProcessRun ,showProcessArgDebug) where import Control.Monad.Logger import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import Language.Haskell.TH import System.Process (CreateProcess(..), CmdSpec(..)) -- | Log running a process with its arguments, for debugging (-v). logCreateProcess :: Q Exp logCreateProcess = [|let f :: MonadLogger m => CreateProcess -> m () f (CreateProcess { cmdspec = ShellCommand shellCmd }) = $logDebug ("Creating shell process: " <> T.pack shellCmd) f (CreateProcess { cmdspec = RawCommand name args }) = $logDebug ("Creating process: " <> T.pack name <> " " <> T.intercalate " " (map showProcessArgDebug args)) in f|] -- | Log running a process with its arguments, for debugging (-v). logProcessRun :: Q Exp logProcessRun = [|let f :: MonadLogger m => String -> [String] -> m () f name args = $logDebug ("Run process: " <> T.pack name <> " " <> T.intercalate " " (map showProcessArgDebug args)) in f|] -- | Show a process arg including speechmarks when necessary. Just for -- debugging purposes, not functionally important. showProcessArgDebug :: String -> Text showProcessArgDebug x | any special x = T.pack (show x) | otherwise = T.pack x where special '"' = True special ' ' = True special _ = False stack-1.1.2/src/System/Process/PagerEditor.hs0000644000000000000000000001167012630674604017255 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, RankNTypes, DeriveDataTypeable #-} -- | Run external pagers (@$PAGER@, @less@, @more@) and editors (@$VISUAL@, -- @$EDITOR@, @nano@, @pico@, @vi@). module System.Process.PagerEditor (-- * Pager pageWriter ,pageByteString ,pageBuilder ,pageFile ,pageString ,PagerException(..) -- * Editor ,editFile ,editReaderWriter ,editByteString ,editString ,EditorException(..)) where import Control.Exception (try,IOException,throwIO,Exception) import Data.ByteString.Lazy (ByteString,hPut,readFile) import Data.ByteString.Builder (Builder,stringUtf8,hPutBuilder) import Data.Typeable (Typeable) import System.Directory (findExecutable) import System.Environment (lookupEnv) import System.Exit (ExitCode(..)) import System.FilePath (()) import System.Process (createProcess,shell,proc,waitForProcess,StdStream (CreatePipe) ,CreateProcess(std_in, close_fds, delegate_ctlc)) import System.IO (hClose,Handle,hPutStr,readFile,withFile,IOMode(WriteMode),stdout) import System.IO.Temp (withSystemTempDirectory) -- | Run pager, providing a function that writes to the pager's input. pageWriter :: (Handle -> IO ()) -> IO () pageWriter writer = do mpager <- lookupEnv "PAGER" `orElse` findExecutable "less" `orElse` findExecutable "more" case mpager of Just pager -> do (Just h,_,_,procHandle) <- createProcess (shell pager) {std_in = CreatePipe ,close_fds = True ,delegate_ctlc = True} (_::Either IOException ()) <- try (do writer h hClose h) exit <- waitForProcess procHandle case exit of ExitSuccess -> return () ExitFailure n -> throwIO (PagerExitFailure pager n) return () Nothing -> writer stdout -- | Run pager to display a lazy ByteString. pageByteString :: ByteString -> IO () pageByteString = pageWriter . flip hPut -- | Run pager to display a ByteString-Builder. pageBuilder :: Builder -> IO () pageBuilder = pageWriter . flip hPutBuilder -- | Run pager to display contents of a file. pageFile :: FilePath -> IO () pageFile p = pageByteString =<< Data.ByteString.Lazy.readFile p -- | Run pager to display a string. pageString :: String -> IO () pageString = pageBuilder . stringUtf8 -- | Run editor to edit a file. editFile :: FilePath -> IO () editFile path = do meditor <- lookupEnv "VISUAL" `orElse` lookupEnv "EDITOR" `orElse` findExecutable "nano" `orElse` findExecutable "pico" `orElse` findExecutable "vi" case meditor of Just editor -> do (_,_,_,procHandle) <- createProcess (proc "sh" ["-c", editor ++ " \"$1\"", "sh", path]) {close_fds = True,delegate_ctlc = True} exitCode <- waitForProcess procHandle case exitCode of ExitSuccess -> return () ExitFailure n -> throwIO (EditorExitFailure editor n) Nothing -> throwIO EditorNotFound -- | Run editor, providing functions to write and read the file contents. editReaderWriter :: forall a. String -> (Handle -> IO ()) -> (FilePath -> IO a) -> IO a editReaderWriter filename writer reader = withSystemTempDirectory "" (\p -> do let p' = p filename withFile p' WriteMode writer editFile p' reader p') -- | Run editor on a ByteString. editByteString :: String -> ByteString -> IO ByteString editByteString f s = editReaderWriter f (`hPut` s) Data.ByteString.Lazy.readFile -- | Run editor on a String. editString :: String -> String -> IO String editString f s = editReaderWriter f (`hPutStr` s) System.IO.readFile -- | Short-circuit first Just. orElse :: (Monad m) => m (Maybe a) -> m (Maybe a) -> m (Maybe a) orElse a b = do m <- a case m of Just _ -> return m Nothing -> b -- | Exception running pager. data PagerException = PagerNotFound | PagerExitFailure FilePath Int deriving Typeable instance Show PagerException where show PagerNotFound = "No pager found (tried $PAGER, `less`, and `more`.)" show (PagerExitFailure p n) = "Pager (`" ++ p ++ "') exited with non-zero status: " ++ show n instance Exception PagerException -- | Exception running editor. data EditorException = EditorNotFound | EditorExitFailure FilePath Int deriving Typeable instance Show EditorException where show EditorNotFound = "No editor found (tried $VISUAL, $PAGER, `nano`, `pico`, and `vi`.)" show (EditorExitFailure p n) = "Editor (`" ++ p ++ "') exited with non-zero status: " ++ show n instance Exception EditorException stack-1.1.2/src/System/Process/Read.hs0000644000000000000000000004004412701273661015715 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} -- | Reading from external processes. module System.Process.Read (readProcessStdout ,tryProcessStdout ,sinkProcessStdout ,sinkProcessStderrStdout ,sinkProcessStderrStdoutHandle ,logProcessStderrStdout ,readProcess ,EnvOverride(..) ,unEnvOverride ,mkEnvOverride ,modifyEnvOverride ,envHelper ,doesExecutableExist ,findExecutable ,getEnvOverride ,envSearchPath ,preProcess ,readProcessNull ,readInNull ,logProcessRun ,ReadProcessException (..) ,augmentPath ,augmentPathMap ) where import Control.Arrow ((***), first) import Control.Concurrent.Async (concurrently) import Control.Exception hiding (try, catch) import Control.Monad (join, liftM, unless, void) import Control.Monad.Catch (MonadThrow, MonadCatch, throwM, try, catch) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Logger import Control.Monad.Trans.Control (MonadBaseControl, liftBaseWith) import qualified Data.ByteString as S import Data.ByteString.Builder import qualified Data.ByteString.Lazy as L import Data.Conduit import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import Data.Conduit.Process hiding (callProcess) import Data.Foldable (forM_) import Data.IORef import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (isJust, maybeToList) import Data.Monoid import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT import Data.Typeable (Typeable) import Distribution.System (OS (Windows), Platform (Platform)) import Language.Haskell.TH as TH (location) import Path import Path.IO hiding (findExecutable) import Prelude -- Fix AMP warning import qualified System.Directory as D import System.Environment (getEnvironment) import System.Exit import qualified System.FilePath as FP import System.IO (Handle) import System.Process.Log -- | Override the environment received by a child process. data EnvOverride = EnvOverride { eoTextMap :: Map Text Text -- ^ Environment variables as map , eoStringList :: [(String, String)] -- ^ Environment variables as association list , eoPath :: [FilePath] -- ^ List of directories searched for executables (@PATH@) , eoExeCache :: IORef (Map FilePath (Either ReadProcessException (Path Abs File))) , eoExeExtension :: String -- ^ @""@ or @".exe"@, depending on the platform , eoPlatform :: Platform } -- | Get the environment variables from an 'EnvOverride'. unEnvOverride :: EnvOverride -> Map Text Text unEnvOverride = eoTextMap -- | Get the list of directories searched (@PATH@). envSearchPath :: EnvOverride -> [FilePath] envSearchPath = eoPath -- | Modify the environment variables of an 'EnvOverride'. modifyEnvOverride :: MonadIO m => EnvOverride -> (Map Text Text -> Map Text Text) -> m EnvOverride modifyEnvOverride eo f = mkEnvOverride (eoPlatform eo) (f $ eoTextMap eo) -- | Create a new 'EnvOverride'. mkEnvOverride :: MonadIO m => Platform -> Map Text Text -> m EnvOverride mkEnvOverride platform tm' = do ref <- liftIO $ newIORef Map.empty return EnvOverride { eoTextMap = tm , eoStringList = map (T.unpack *** T.unpack) $ Map.toList tm , eoPath = maybe [] (FP.splitSearchPath . T.unpack) (Map.lookup "PATH" tm) , eoExeCache = ref , eoExeExtension = if isWindows then ".exe" else "" , eoPlatform = platform } where -- Fix case insensitivity of the PATH environment variable on Windows. tm | isWindows = Map.fromList $ map (first T.toUpper) $ Map.toList tm' | otherwise = tm' -- Don't use CPP so that the Windows code path is at least type checked -- regularly isWindows = case platform of Platform _ Windows -> True _ -> False -- | Helper conversion function. envHelper :: EnvOverride -> Maybe [(String, String)] envHelper = Just . eoStringList -- | Read from the process, ignoring any output. readProcessNull :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => Maybe (Path Abs Dir) -- ^ Optional working directory -> EnvOverride -> String -- ^ Command -> [String] -- ^ Command line arguments -> m () readProcessNull wd menv name args = sinkProcessStdout wd menv name args CL.sinkNull -- | Run the given command in the given directory. If it exits with anything -- but success, print an error and then call 'exitWith' to exit the program. readInNull :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => Path Abs Dir -- ^ Directory to run in -> FilePath -- ^ Command to run -> EnvOverride -> [String] -- ^ Command line arguments -> Maybe Text -- ^ Optional additional error message -> m () readInNull wd cmd menv args errMsg = do result <- try (readProcessNull (Just wd) menv cmd args) case result of Left ex -> do $logError (T.pack (show ex)) case ex of ReadProcessException{} -> forM_ errMsg $logError _ -> return () liftIO exitFailure Right () -> return () -- | Try to produce a strict 'S.ByteString' from the stdout of a -- process. tryProcessStdout :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => Maybe (Path Abs Dir) -- ^ Optional directory to run in -> EnvOverride -> String -- ^ Command -> [String] -- ^ Command line arguments -> m (Either ReadProcessException S.ByteString) tryProcessStdout wd menv name args = try (readProcessStdout wd menv name args) -- | Produce a strict 'S.ByteString' from the stdout of a process. -- -- Throws a 'ReadProcessException' exception if the process fails. readProcessStdout :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => Maybe (Path Abs Dir) -- ^ Optional directory to run in -> EnvOverride -> String -- ^ Command -> [String] -- ^ Command line arguments -> m S.ByteString readProcessStdout wd menv name args = sinkProcessStdout wd menv name args CL.consume >>= liftIO . evaluate . S.concat -- | An exception while trying to read from process. data ReadProcessException = ReadProcessException CreateProcess ExitCode L.ByteString L.ByteString | NoPathFound | ExecutableNotFound String [FilePath] | ExecutableNotFoundAt FilePath deriving Typeable instance Show ReadProcessException where show (ReadProcessException cp ec out err) = concat $ [ "Running " , showSpec $ cmdspec cp] ++ maybe [] (\x -> [" in directory ", x]) (cwd cp) ++ [ " exited with " , show ec , "\n\n" , toStr out , "\n" , toStr err ] where toStr = LT.unpack . LT.decodeUtf8With lenientDecode showSpec (ShellCommand str) = str showSpec (RawCommand cmd args) = unwords $ cmd : map (T.unpack . showProcessArgDebug) args show NoPathFound = "PATH not found in EnvOverride" show (ExecutableNotFound name path) = concat [ "Executable named " , name , " not found on path: " , show path ] show (ExecutableNotFoundAt name) = "Did not find executable at specified path: " ++ name instance Exception ReadProcessException -- | Consume the stdout of a process feeding strict 'S.ByteString's to a consumer. -- If the process fails, spits out stdout and stderr as error log -- level. Should not be used for long-running processes or ones with -- lots of output; for that use 'sinkProcessStdoutLogStderr'. sinkProcessStdout :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => Maybe (Path Abs Dir) -- ^ Optional directory to run in -> EnvOverride -> String -- ^ Command -> [String] -- ^ Command line arguments -> Sink S.ByteString IO a -- ^ Sink for stdout -> m a sinkProcessStdout wd menv name args sinkStdout = do stderrBuffer <- liftIO (newIORef mempty) stdoutBuffer <- liftIO (newIORef mempty) (_,sinkRet) <- catch (sinkProcessStderrStdout wd menv name args (CL.mapM_ (\bytes -> liftIO (modifyIORef' stderrBuffer (<> byteString bytes)))) (CL.iterM (\bytes -> liftIO (modifyIORef' stdoutBuffer (<> byteString bytes))) $= sinkStdout)) (\(ProcessExitedUnsuccessfully cp ec) -> do stderrBuilder <- liftIO (readIORef stderrBuffer) stdoutBuilder <- liftIO (readIORef stdoutBuffer) throwM $ ReadProcessException cp ec (toLazyByteString stdoutBuilder) (toLazyByteString stderrBuilder)) return sinkRet logProcessStderrStdout :: (MonadIO m, MonadBaseControl IO m, MonadLogger m) => Maybe (Path Abs Dir) -> String -> EnvOverride -> [String] -> m () logProcessStderrStdout mdir name menv args = liftBaseWith $ \restore -> do let logLines = CB.lines =$ CL.mapM_ (void . restore . monadLoggerLog $(TH.location >>= liftLoc) "" LevelInfo . toLogStr) void $ restore $ sinkProcessStderrStdout mdir menv name args logLines logLines -- | Consume the stdout and stderr of a process feeding strict 'S.ByteString's to the consumers. sinkProcessStderrStdout :: forall m e o. (MonadIO m, MonadLogger m) => Maybe (Path Abs Dir) -- ^ Optional directory to run in -> EnvOverride -> String -- ^ Command -> [String] -- ^ Command line arguments -> Sink S.ByteString IO e -- ^ Sink for stderr -> Sink S.ByteString IO o -- ^ Sink for stdout -> m (e,o) sinkProcessStderrStdout wd menv name args sinkStderr sinkStdout = do $logProcessRun name args name' <- preProcess wd menv name liftIO $ withCheckedProcess (proc name' args) { env = envHelper menv, cwd = fmap toFilePath wd } (\ClosedStream out err -> f err out) where f :: Source IO S.ByteString -> Source IO S.ByteString -> IO (e, o) f err out = (err $$ sinkStderr) `concurrently` (out $$ sinkStdout) sinkProcessStderrStdoutHandle :: (MonadIO m, MonadLogger m) => Maybe (Path Abs Dir) -- ^ Optional directory to run in -> EnvOverride -> String -- ^ Command -> [String] -- ^ Command line arguments -> Handle -> Handle -> m () sinkProcessStderrStdoutHandle wd menv name args err out = do $logProcessRun name args name' <- preProcess wd menv name liftIO $ withCheckedProcess (proc name' args) { env = envHelper menv , cwd = fmap toFilePath wd , std_err = UseHandle err , std_out = UseHandle out } (\ClosedStream UseProvidedHandle UseProvidedHandle -> return ()) -- | Perform pre-call-process tasks. Ensure the working directory exists and find the -- executable path. preProcess :: (MonadIO m) => Maybe (Path Abs Dir) -- ^ Optional directory to create if necessary -> EnvOverride -- ^ How to override environment -> String -- ^ Command name -> m FilePath preProcess wd menv name = do name' <- liftIO $ liftM toFilePath $ join $ findExecutable menv name maybe (return ()) ensureDir wd return name' -- | Check if the given executable exists on the given PATH. doesExecutableExist :: (MonadIO m) => EnvOverride -- ^ How to override environment -> String -- ^ Name of executable -> m Bool doesExecutableExist menv name = liftM isJust $ findExecutable menv name -- | Find the complete path for the executable. -- -- Throws a 'ReadProcessException' if unsuccessful. findExecutable :: (MonadIO m, MonadThrow n) => EnvOverride -- ^ How to override environment -> String -- ^ Name of executable -> m (n (Path Abs File)) -- ^ Full path to that executable on success findExecutable eo name0 | any FP.isPathSeparator name0 = do let names0 | null (eoExeExtension eo) = [name0] -- Support `stack exec foo/bar.exe` on Windows | otherwise = [name0 ++ eoExeExtension eo, name0] testNames [] = return $ throwM $ ExecutableNotFoundAt name0 testNames (name:names) = do exists <- liftIO $ D.doesFileExist name if exists then do path <- liftIO $ resolveFile' name return $ return path else testNames names testNames names0 findExecutable eo name = liftIO $ do m <- readIORef $ eoExeCache eo epath <- case Map.lookup name m of Just epath -> return epath Nothing -> do let loop [] = return $ Left $ ExecutableNotFound name (eoPath eo) loop (dir:dirs) = do let fp0 = dir FP. name fps0 | null (eoExeExtension eo) = [fp0] -- Support `stack exec foo.exe` on Windows | otherwise = [fp0 ++ eoExeExtension eo, fp0] testFPs [] = loop dirs testFPs (fp:fps) = do exists <- D.doesFileExist fp if exists then do fp' <- D.makeAbsolute fp >>= parseAbsFile return $ return fp' else testFPs fps testFPs fps0 epath <- loop $ eoPath eo () <- atomicModifyIORef (eoExeCache eo) $ \m' -> (Map.insert name epath m', ()) return epath return $ either throwM return epath -- | Load up an 'EnvOverride' from the standard environment. getEnvOverride :: MonadIO m => Platform -> m EnvOverride getEnvOverride platform = liftIO $ getEnvironment >>= mkEnvOverride platform . Map.fromList . map (T.pack *** T.pack) data PathException = PathsInvalidInPath [FilePath] deriving Typeable instance Exception PathException instance Show PathException where show (PathsInvalidInPath paths) = unlines $ [ "Would need to add some paths to the PATH environment variable \ \to continue, but they would be invalid because they contain a " ++ show FP.searchPathSeparator ++ "." , "Please fix the following paths and try again:" ] ++ paths -- | Augment the PATH environment variable with the given extra paths. augmentPath :: MonadThrow m => [FilePath] -> Maybe Text -> m Text augmentPath dirs mpath = do let illegal = filter (FP.searchPathSeparator `elem`) dirs unless (null illegal) (throwM $ PathsInvalidInPath illegal) return $ T.intercalate (T.singleton FP.searchPathSeparator) $ map (T.pack . FP.dropTrailingPathSeparator) dirs ++ maybeToList mpath -- | Apply 'augmentPath' on the PATH value in the given Map. augmentPathMap :: MonadThrow m => [FilePath] -> Map Text Text -> m (Map Text Text) augmentPathMap dirs origEnv = do path <- augmentPath dirs mpath return $ Map.insert "PATH" path origEnv where mpath = Map.lookup "PATH" origEnv stack-1.1.2/src/System/Process/Run.hs0000644000000000000000000001147612701273661015615 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} -- | Run sub-processes. module System.Process.Run (runCmd ,runCmd' ,callProcess ,callProcess' ,callProcessInheritStderrStdout ,createProcess' ,ProcessExitedUnsuccessfully ,Cmd(..) ) where import Control.Exception.Lifted import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Logger (MonadLogger, logError) import Control.Monad.Trans.Control (MonadBaseControl) import Data.Conduit.Process hiding (callProcess) import Data.Foldable (forM_) import Data.Text (Text) import qualified Data.Text as T import Path (Dir, Abs, Path) import Path (toFilePath) import Prelude -- Fix AMP warning import System.Exit (exitWith, ExitCode (..)) import System.IO import qualified System.Process import System.Process.Log import System.Process.Read -- | Cmd holds common infos needed to running a process in most cases data Cmd = Cmd { cmdDirectoryToRunIn :: Maybe (Path Abs Dir) -- ^ directory to run in , cmdCommandToRun :: FilePath -- ^ command to run , cmdEnvOverride::EnvOverride , cmdCommandLineArguments :: [String] -- ^ command line arguments } -- | Run the given command in the given directory, inheriting stdout and stderr. -- -- If it exits with anything but success, prints an error -- and then calls 'exitWith' to exit the program. runCmd :: forall (m :: * -> *). (MonadLogger m,MonadIO m,MonadBaseControl IO m) => Cmd -> Maybe Text -- ^ optional additional error message -> m () runCmd = runCmd' id runCmd' :: forall (m :: * -> *). (MonadLogger m,MonadIO m,MonadBaseControl IO m) => (CreateProcess -> CreateProcess) -> Cmd -> Maybe Text -- ^ optional additional error message -> m () runCmd' modCP cmd@(Cmd{..}) mbErrMsg = do result <- try (callProcess' modCP cmd) case result of Left (ProcessExitedUnsuccessfully _ ec) -> do $logError $ T.pack $ concat $ [ "Exit code " , show ec , " while running " , show (cmdCommandToRun : cmdCommandLineArguments) ] ++ (case cmdDirectoryToRunIn of Nothing -> [] Just mbDir -> [" in ", toFilePath mbDir] ) forM_ mbErrMsg $logError liftIO (exitWith ec) Right () -> return () -- | Like 'System.Process.callProcess', but takes an optional working directory and -- environment override, and throws 'ProcessExitedUnsuccessfully' if the -- process exits unsuccessfully. -- -- Inherits stdout and stderr. callProcess :: (MonadIO m, MonadLogger m) => Cmd -> m () callProcess = callProcess' id -- | Like 'System.Process.callProcess', but takes an optional working directory and -- environment override, and throws 'ProcessExitedUnsuccessfully' if the -- process exits unsuccessfully. -- -- Inherits stdout and stderr. callProcess' :: (MonadIO m, MonadLogger m) => (CreateProcess -> CreateProcess) -> Cmd -> m () callProcess' modCP cmd = do c <- liftM modCP (cmdToCreateProcess cmd) $logCreateProcess c liftIO $ do (_, _, _, p) <- System.Process.createProcess c exit_code <- waitForProcess p case exit_code of ExitSuccess -> return () ExitFailure _ -> throwIO (ProcessExitedUnsuccessfully c exit_code) callProcessInheritStderrStdout :: (MonadIO m, MonadLogger m) => Cmd -> m () callProcessInheritStderrStdout cmd = do let inheritOutput cp = cp { std_in = CreatePipe, std_out = Inherit, std_err = Inherit } callProcess' inheritOutput cmd -- | Like 'System.Process.Internal.createProcess_', but taking a 'Cmd'. -- Note that the 'Handle's provided by 'UseHandle' are not closed -- automatically. createProcess' :: (MonadIO m, MonadLogger m) => String -> (CreateProcess -> CreateProcess) -> Cmd -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) createProcess' tag modCP cmd = do c <- liftM modCP (cmdToCreateProcess cmd) $logCreateProcess c liftIO $ System.Process.createProcess_ tag c cmdToCreateProcess :: MonadIO m => Cmd -> m CreateProcess cmdToCreateProcess (Cmd wd cmd0 menv args) = do cmd <- preProcess wd menv cmd0 return $ (proc cmd args) { delegate_ctlc = True , cwd = fmap toFilePath wd , env = envHelper menv } stack-1.1.2/src/main/Main.hs0000644000000000000000000015312112717707441013756 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} -- | Main stack tool entry point. module Main (main) where import Control.Exception import qualified Control.Exception.Lifted as EL import Control.Monad hiding (mapM, forM) import Control.Monad.IO.Class import Control.Monad.Logger import Control.Monad.Reader (ask, asks,local,runReaderT) import Control.Monad.Trans.Control (MonadBaseControl) import Data.Attoparsec.Args (parseArgs, EscapingMode (Escaping)) import Data.Attoparsec.Interpreter (getInterpreterArgs) import qualified Data.ByteString.Lazy as L import Data.IORef import Data.List import qualified Data.Map as Map import qualified Data.Map.Strict as M import Data.Maybe import Data.Maybe.Extra (mapMaybeA) import Data.Monoid import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import Data.Traversable import Data.Typeable (Typeable) import Data.Version (showVersion) #ifdef USE_GIT_INFO import Development.GitRev (gitCommitCount, gitHash) #endif import Distribution.System (buildArch, buildPlatform) import Distribution.Text (display) import GHC.IO.Encoding (mkTextEncoding, textEncodingName) import Lens.Micro import Network.HTTP.Client import Options.Applicative import Options.Applicative.Args import Options.Applicative.Help (errorHelp, stringChunk, vcatChunks) import Options.Applicative.Builder.Extra import Options.Applicative.Complicated #ifdef USE_GIT_INFO import Options.Applicative.Simple (simpleVersion) #endif import Options.Applicative.Types (readerAsk, ParserHelp(..)) import Path import Path.Extra (toFilePathNoTrailingSep) import Path.IO import qualified Paths_stack as Meta import Prelude hiding (pi, mapM) import Stack.Build import Stack.Clean (CleanOpts, clean) import Stack.Config import Stack.ConfigCmd as ConfigCmd import Stack.Constants import Stack.Coverage import qualified Stack.Docker as Docker import Stack.Dot import Stack.Exec import qualified Stack.Nix as Nix import Stack.Fetch import Stack.FileWatch import Stack.GhcPkg (getGlobalDB, mkGhcPackagePath) import Stack.Ghci import Stack.Ide import qualified Stack.Image as Image import Stack.Init import Stack.New import Stack.Options import Stack.Package (findOrGenerateCabalFile) import qualified Stack.PackageIndex import Stack.SDist (getSDistTarball, checkSDistTarball, checkSDistTarball') import Stack.Setup import qualified Stack.Sig as Sig import Stack.Solver (solveExtraDeps) import Stack.Types import Stack.Types.Internal import Stack.Types.StackT import Stack.Upgrade import qualified Stack.Upload as Upload import qualified System.Directory as D import System.Environment (getEnvironment, getProgName, getArgs, withArgs) import System.Exit import System.FileLock (lockFile, tryLockFile, unlockFile, SharedExclusive(Exclusive), FileLock) import System.FilePath (pathSeparator, searchPathSeparator) import System.IO (hIsTerminalDevice, stderr, stdin, stdout, hSetBuffering, BufferMode(..), hPutStrLn, Handle, hGetEncoding, hSetEncoding) import System.Process.Read -- | Change the character encoding of the given Handle to transliterate -- on unsupported characters instead of throwing an exception hSetTranslit :: Handle -> IO () hSetTranslit h = do menc <- hGetEncoding h case fmap textEncodingName menc of Just name | '/' `notElem` name -> do enc' <- mkTextEncoding $ name ++ "//TRANSLIT" hSetEncoding h enc' _ -> return () versionString' :: String #ifdef USE_GIT_INFO versionString' = concat $ concat [ [$(simpleVersion Meta.version)] -- Leave out number of commits for --depth=1 clone -- See https://github.com/commercialhaskell/stack/issues/792 , [" (" ++ commitCount ++ " commits)" | commitCount /= ("1"::String) && commitCount /= ("UNKNOWN" :: String)] , [" ", display buildArch] , [" hpack-", VERSION_hpack] ] where commitCount = $gitCommitCount #else versionString' = showVersion Meta.version ++ ' ' : display buildArch ++ " hpack" ++ VERSION_hpack #endif main :: IO () main = do -- Line buffer the output by default, particularly for non-terminal runs. -- See https://github.com/commercialhaskell/stack/pull/360 hSetBuffering stdout LineBuffering hSetBuffering stdin LineBuffering hSetBuffering stderr LineBuffering hSetTranslit stdout hSetTranslit stderr args <- getArgs progName <- getProgName isTerminal <- hIsTerminalDevice stdout execExtraHelp args Docker.dockerHelpOptName (dockerOptsParser False) ("Only showing --" ++ Docker.dockerCmdName ++ "* options.") execExtraHelp args Nix.nixHelpOptName (nixOptsParser False) ("Only showing --" ++ Nix.nixCmdName ++ "* options.") eGlobalRun <- try $ commandLineHandler progName False case eGlobalRun of Left (exitCode :: ExitCode) -> do throwIO exitCode Right (globalMonoid,run) -> do let global = globalOptsFromMonoid isTerminal globalMonoid when (globalLogLevel global == LevelDebug) $ hPutStrLn stderr versionString' case globalReExecVersion global of Just expectVersion | expectVersion /= showVersion Meta.version -> throwIO $ InvalidReExecVersion expectVersion (showVersion Meta.version) _ -> return () run global `catch` \e -> -- This special handler stops "stack: " from being printed before the -- exception case fromException e of Just ec -> exitWith ec Nothing -> do printExceptionStderr e exitFailure -- Vertically combine only the error component of the first argument with the -- error component of the second. vcatErrorHelp :: ParserHelp -> ParserHelp -> ParserHelp vcatErrorHelp (ParserHelp e1 _ _ _ _) (ParserHelp e2 h2 u2 b2 f2) = ParserHelp (vcatChunks [e2, e1]) h2 u2 b2 f2 commandLineHandler :: String -> Bool -> IO (GlobalOptsMonoid, GlobalOpts -> IO ()) commandLineHandler progName isInterpreter = complicatedOptions Meta.version (Just versionString') VERSION_hpack "stack - The Haskell Tool Stack" "" (globalOpts OuterGlobalOpts) (Just failureCallback) addCommands where failureCallback f args = case stripPrefix "Invalid argument" (fst (renderFailure f "")) of Just _ -> if isInterpreter then parseResultHandler args f else secondaryCommandHandler args f >>= interpreterHandler args Nothing -> parseResultHandler args f parseResultHandler args f = if isInterpreter then do let hlp = errorHelp $ stringChunk (unwords ["Error executing interpreter command:" , progName , unwords args]) handleParseResult (overFailure (vcatErrorHelp hlp) (Failure f)) else handleParseResult (Failure f) addCommands = do when (not isInterpreter) (do addBuildCommand' "build" "Build the package(s) in this directory/configuration" buildCmd (buildOptsParser Build) addBuildCommand' "install" "Shortcut for 'build --copy-bins'" buildCmd (buildOptsParser Install) addCommand' "uninstall" "DEPRECATED: This command performs no actions, and is present for documentation only" uninstallCmd (many $ strArgument $ metavar "IGNORED") addBuildCommand' "test" "Shortcut for 'build --test'" buildCmd (buildOptsParser Test) addBuildCommand' "bench" "Shortcut for 'build --bench'" buildCmd (buildOptsParser Bench) addBuildCommand' "haddock" "Shortcut for 'build --haddock'" buildCmd (buildOptsParser Haddock) addCommand' "new" "Create a new project from a template. Run `stack templates' to see available templates." newCmd newOptsParser addCommand' "templates" "List the templates available for `stack new'." templatesCmd (pure ()) addCommand' "init" "Create stack project config from cabal or hpack package specifications" initCmd initOptsParser addCommand' "solver" "Add missing extra-deps to stack project config" solverCmd solverOptsParser addCommand' "setup" "Get the appropriate GHC for your project" setupCmd setupParser addCommand' "path" "Print out handy path information" pathCmd (mapMaybeA (\(desc,name,_) -> flag Nothing (Just name) (long (T.unpack name) <> help desc)) paths) addCommand' "unpack" "Unpack one or more packages locally" unpackCmd (some $ strArgument $ metavar "PACKAGE") addCommand' "update" "Update the package index" updateCmd (pure ()) addCommand' "upgrade" "Upgrade to the latest stack (experimental)" upgradeCmd ((,) <$> switch ( long "git" <> help "Clone from Git instead of downloading from Hackage (more dangerous)" ) <*> strOption ( long "git-repo" <> help "Clone from specified git repository" <> value "https://github.com/commercialhaskell/stack" <> showDefault )) addCommand' "upload" "Upload a package to Hackage" uploadCmd ((,,,,) <$> many (strArgument $ metavar "TARBALL/DIR") <*> optional pvpBoundsOption <*> ignoreCheckSwitch <*> switch (long "no-signature" <> help "Do not sign & upload signatures") <*> strOption (long "sig-server" <> metavar "URL" <> showDefault <> value "https://sig.commercialhaskell.org" <> help "URL")) addCommand' "sdist" "Create source distribution tarballs" sdistCmd ((,,,,) <$> many (strArgument $ metavar "DIR") <*> optional pvpBoundsOption <*> ignoreCheckSwitch <*> switch (long "sign" <> help "Sign & upload signatures") <*> strOption (long "sig-server" <> metavar "URL" <> showDefault <> value "https://sig.commercialhaskell.org" <> help "URL")) addCommand' "dot" "Visualize your project's dependency graph using Graphviz dot" dotCmd dotOptsParser addCommand' "exec" "Execute a command" execCmd (execOptsParser Nothing) addCommand' "ghc" "Run ghc" execCmd (execOptsParser $ Just ExecGhc) addCommand' "ghci" "Run ghci in the context of package(s) (experimental)" ghciCmd ghciOptsParser addCommand' "repl" "Run ghci in the context of package(s) (experimental) (alias for 'ghci')" ghciCmd ghciOptsParser ) -- These two are the only commands allowed in interpreter mode as well addCommand' "runghc" "Run runghc" execCmd (execOptsParser $ Just ExecRunGhc) addCommand' "runhaskell" "Run runghc (alias for 'runghc')" execCmd (execOptsParser $ Just ExecRunGhc) when (not isInterpreter) (do addCommand' "eval" "Evaluate some haskell code inline. Shortcut for 'stack exec ghc -- -e CODE'" evalCmd (evalOptsParser "CODE") addCommand' "clean" "Clean the local packages" cleanCmd cleanOptsParser addCommand' "list-dependencies" "List the dependencies" listDependenciesCmd (textOption (long "separator" <> metavar "SEP" <> help ("Separator between package name " <> "and package version.") <> value " " <> showDefault)) addCommand' "query" "Query general build information (experimental)" queryCmd (many $ strArgument $ metavar "SELECTOR...") addSubCommands' "ide" "IDE-specific commands" (do addCommand' "start" "Start the ide-backend service" ideCmd ((,) <$> many (textArgument (metavar "TARGET" <> help ("If none specified, use all " <> "packages defined in current directory"))) <*> argsOption (long "ghc-options" <> metavar "OPTION" <> help "Additional options passed to GHCi" <> value [])) addCommand' "packages" "List all available local loadable packages" packagesCmd (pure ()) addCommand' "load-targets" "List all load targets for a package target" targetsCmd (textArgument (metavar "TARGET"))) addSubCommands' Docker.dockerCmdName "Subcommands specific to Docker use" (do addCommand' Docker.dockerPullCmdName "Pull latest version of Docker image from registry" dockerPullCmd (pure ()) addCommand' "reset" "Reset the Docker sandbox" dockerResetCmd (switch (long "keep-home" <> help "Do not delete sandbox's home directory")) addCommand' Docker.dockerCleanupCmdName "Clean up Docker images and containers" dockerCleanupCmd dockerCleanupOptsParser) addSubCommands' ConfigCmd.cfgCmdName "Subcommands specific to modifying stack.yaml files" (addCommand' ConfigCmd.cfgCmdSetName "Sets a field in the project's stack.yaml to value" cfgSetCmd configCmdSetParser) addSubCommands' Image.imgCmdName "Subcommands specific to imaging" (addCommand' Image.imgDockerCmdName "Build a Docker image for the project" imgDockerCmd ((,) <$> boolFlags True "build" "building the project before creating the container" idm <*> many (textOption (long "image" <> help "A specific container image name to build")))) addSubCommands' "hpc" "Subcommands specific to Haskell Program Coverage" (addCommand' "report" "Generate HPC report a combined HPC report" hpcReportCmd hpcReportOptsParser) ) where ignoreCheckSwitch = switch (long "ignore-check" <> help "Do not check package for common mistakes") -- addCommand hiding global options addCommand' cmd title constr = addCommand cmd title globalFooter constr (globalOpts OtherCmdGlobalOpts) addSubCommands' cmd title = addSubCommands cmd title globalFooter (globalOpts OtherCmdGlobalOpts) -- Additional helper that hides global options and shows build options addBuildCommand' cmd title constr = addCommand cmd title globalFooter constr (globalOpts BuildCmdGlobalOpts) globalOpts kind = extraHelpOption hide progName (Docker.dockerCmdName ++ "*") Docker.dockerHelpOptName <*> extraHelpOption hide progName (Nix.nixCmdName ++ "*") Nix.nixHelpOptName <*> globalOptsParser kind (if isInterpreter then Just $ LevelOther "silent" else Nothing) where hide = kind /= OuterGlobalOpts globalFooter = "Run 'stack --help' for global options that apply to all subcommands." -- | fall-through to external executables in `git` style if they exist -- (i.e. `stack something` looks for `stack-something` before -- failing with "Invalid argument `something'") secondaryCommandHandler :: [String] -> ParserFailure ParserHelp -> IO (ParserFailure ParserHelp) secondaryCommandHandler args f = -- don't even try when the argument looks like a path or flag if elem pathSeparator cmd || "-" `isPrefixOf` (head args) then return f else do mExternalExec <- D.findExecutable cmd case mExternalExec of Just ex -> do menv <- getEnvOverride buildPlatform -- TODO show the command in verbose mode -- hPutStrLn stderr $ unwords $ -- ["Running", "[" ++ ex, unwords (tail args) ++ "]"] _ <- runNoLoggingT (exec menv ex (tail args)) return f Nothing -> return $ fmap (vcatErrorHelp (noSuchCmd cmd)) f where -- FIXME this is broken when any options are specified before the command -- e.g. stack --verbosity silent cmd cmd = stackProgName ++ "-" ++ (head args) noSuchCmd name = errorHelp $ stringChunk ("Auxiliary command not found in path `" ++ name ++ "'") interpreterHandler :: Monoid t => [String] -> ParserFailure ParserHelp -> IO (GlobalOptsMonoid, (GlobalOpts -> IO (), t)) interpreterHandler args f = do isFile <- D.doesFileExist file if isFile then runInterpreterCommand file else parseResultHandler (errorCombine (noSuchFile file)) where file = head args -- if the filename contains a path separator then we know that it is not a -- command it is a file to be interpreted. In that case we only show the -- interpreter error message and exclude the command related error messages. errorCombine = if elem pathSeparator file then overrideErrorHelp else vcatErrorHelp overrideErrorHelp (ParserHelp e1 _ _ _ _) (ParserHelp _ h2 u2 b2 f2) = ParserHelp e1 h2 u2 b2 f2 parseResultHandler fn = handleParseResult (overFailure fn (Failure f)) noSuchFile name = errorHelp $ stringChunk ("File does not exist or is not a regular file `" ++ name ++ "'") runInterpreterCommand path = do progName <- getProgName iargs <- getInterpreterArgs path let parseCmdLine = commandLineHandler progName True let cmdArgs = iargs ++ "--" : args -- TODO show the command in verbose mode -- hPutStrLn stderr $ unwords $ -- ["Running", "[" ++ progName, unwords cmdArgs ++ "]"] (a,b) <- withArgs cmdArgs parseCmdLine return (a,(b,mempty)) -- | Print out useful path information in a human-readable format (and -- support others later). pathCmd :: [Text] -> GlobalOpts -> IO () pathCmd keys go = withBuildConfig go (do env <- ask let cfg = envConfig env bc = envConfigBuildConfig cfg -- This is the modified 'bin-path', -- including the local GHC or MSYS if not configured to operate on -- global GHC. -- It was set up in 'withBuildConfigAndLock -> withBuildConfigExt -> setupEnv'. -- So it's not the *minimal* override path. menv <- getMinimalEnvOverride snap <- packageDatabaseDeps plocal <- packageDatabaseLocal extra <- packageDatabaseExtra global <- getGlobalDB menv =<< getWhichCompiler snaproot <- installationRootDeps localroot <- installationRootLocal distDir <- distRelativeDir hpcDir <- hpcReportDir compiler <- getCompilerPath =<< getWhichCompiler let deprecated = filter ((`elem` keys) . fst) deprecatedPathKeys liftIO $ forM_ deprecated $ \(oldOption, newOption) -> T.hPutStrLn stderr $ T.unlines [ "" , "'--" <> oldOption <> "' will be removed in a future release." , "Please use '--" <> newOption <> "' instead." , "" ] forM_ -- filter the chosen paths in flags (keys), -- or show all of them if no specific paths chosen. (filter (\(_,key,_) -> (null keys && key /= T.pack deprecatedStackRootOptionName) || elem key keys) paths) (\(_,key,path) -> liftIO $ T.putStrLn -- If a single path type is requested, output it directly. -- Otherwise, name all the paths. ((if length keys == 1 then "" else key <> ": ") <> path (PathInfo bc menv snap plocal global snaproot localroot distDir hpcDir extra compiler)))) -- | Passed to all the path printers as a source of info. data PathInfo = PathInfo { piBuildConfig :: BuildConfig , piEnvOverride :: EnvOverride , piSnapDb :: Path Abs Dir , piLocalDb :: Path Abs Dir , piGlobalDb :: Path Abs Dir , piSnapRoot :: Path Abs Dir , piLocalRoot :: Path Abs Dir , piDistDir :: Path Rel Dir , piHpcDir :: Path Abs Dir , piExtraDbs :: [Path Abs Dir] , piCompiler :: Path Abs File } -- | The paths of interest to a user. The first tuple string is used -- for a description that the optparse flag uses, and the second -- string as a machine-readable key and also for @--foo@ flags. The user -- can choose a specific path to list like @--stack-root@. But -- really it's mainly for the documentation aspect. -- -- When printing output we generate @PathInfo@ and pass it to the -- function to generate an appropriate string. Trailing slashes are -- removed, see #506 paths :: [(String, Text, PathInfo -> Text)] paths = [ ( "Global stack root directory" , T.pack stackRootOptionName , T.pack . toFilePathNoTrailingSep . configStackRoot . bcConfig . piBuildConfig ) , ( "Project root (derived from stack.yaml file)" , "project-root" , T.pack . toFilePathNoTrailingSep . bcRoot . piBuildConfig ) , ( "Configuration location (where the stack.yaml file is)" , "config-location" , T.pack . toFilePath . bcStackYaml . piBuildConfig ) , ( "PATH environment variable" , "bin-path" , T.pack . intercalate [searchPathSeparator] . eoPath . piEnvOverride ) , ( "Install location for GHC and other core tools" , "programs" , T.pack . toFilePathNoTrailingSep . configLocalPrograms . bcConfig . piBuildConfig ) , ( "Compiler binary (e.g. ghc)" , "compiler-exe" , T.pack . toFilePath . piCompiler ) , ( "Directory containing the compiler binary (e.g. ghc)" , "compiler-bin" , T.pack . toFilePathNoTrailingSep . parent . piCompiler ) , ( "Local bin dir where stack installs executables (e.g. ~/.local/bin)" , "local-bin" , T.pack . toFilePathNoTrailingSep . configLocalBin . bcConfig . piBuildConfig ) , ( "Extra include directories" , "extra-include-dirs" , T.intercalate ", " . Set.elems . configExtraIncludeDirs . bcConfig . piBuildConfig ) , ( "Extra library directories" , "extra-library-dirs" , T.intercalate ", " . Set.elems . configExtraLibDirs . bcConfig . piBuildConfig ) , ( "Snapshot package database" , "snapshot-pkg-db" , T.pack . toFilePathNoTrailingSep . piSnapDb ) , ( "Local project package database" , "local-pkg-db" , T.pack . toFilePathNoTrailingSep . piLocalDb ) , ( "Global package database" , "global-pkg-db" , T.pack . toFilePathNoTrailingSep . piGlobalDb ) , ( "GHC_PACKAGE_PATH environment variable" , "ghc-package-path" , \pi -> mkGhcPackagePath True (piLocalDb pi) (piSnapDb pi) (piExtraDbs pi) (piGlobalDb pi)) , ( "Snapshot installation root" , "snapshot-install-root" , T.pack . toFilePathNoTrailingSep . piSnapRoot ) , ( "Local project installation root" , "local-install-root" , T.pack . toFilePathNoTrailingSep . piLocalRoot ) , ( "Snapshot documentation root" , "snapshot-doc-root" , \pi -> T.pack (toFilePathNoTrailingSep (piSnapRoot pi docDirSuffix))) , ( "Local project documentation root" , "local-doc-root" , \pi -> T.pack (toFilePathNoTrailingSep (piLocalRoot pi docDirSuffix))) , ( "Dist work directory" , "dist-dir" , T.pack . toFilePathNoTrailingSep . piDistDir ) , ( "Where HPC reports and tix files are stored" , "local-hpc-root" , T.pack . toFilePathNoTrailingSep . piHpcDir ) , ( "DEPRECATED: Use '--local-bin' instead" , "local-bin-path" , T.pack . toFilePathNoTrailingSep . configLocalBin . bcConfig . piBuildConfig ) , ( "DEPRECATED: Use '--programs' instead" , "ghc-paths" , T.pack . toFilePathNoTrailingSep . configLocalPrograms . bcConfig . piBuildConfig ) , ( "DEPRECATED: Use '--" <> stackRootOptionName <> "' instead" , T.pack deprecatedStackRootOptionName , T.pack . toFilePathNoTrailingSep . configStackRoot . bcConfig . piBuildConfig ) ] deprecatedPathKeys :: [(Text, Text)] deprecatedPathKeys = [ (T.pack deprecatedStackRootOptionName, T.pack stackRootOptionName) , ("ghc-paths", "programs") , ("local-bin-path", "local-bin") ] data SetupCmdOpts = SetupCmdOpts { scoCompilerVersion :: !(Maybe CompilerVersion) , scoForceReinstall :: !Bool , scoUpgradeCabal :: !Bool , scoStackSetupYaml :: !String , scoGHCBindistURL :: !(Maybe String) } setupParser :: Parser SetupCmdOpts setupParser = SetupCmdOpts <$> optional (argument readVersion (metavar "GHC_VERSION" <> help ("Version of GHC to install, e.g. 7.10.2. " ++ "The default is to install the version implied by the resolver."))) <*> boolFlags False "reinstall" "reinstalling GHC, even if available (implies no-system-ghc)" idm <*> boolFlags False "upgrade-cabal" "installing the newest version of the Cabal library globally" idm <*> strOption ( long "stack-setup-yaml" <> help "Location of the main stack-setup.yaml file" <> value defaultStackSetupYaml <> showDefault ) <*> optional (strOption (long "ghc-bindist" <> metavar "URL" <> help "Alternate GHC binary distribution (requires custom --ghc-variant)")) where readVersion = do s <- readerAsk case parseCompilerVersion ("ghc-" <> T.pack s) of Nothing -> case parseCompilerVersion (T.pack s) of Nothing -> readerError $ "Invalid version: " ++ s Just x -> return x Just x -> return x setupCmd :: SetupCmdOpts -> GlobalOpts -> IO () setupCmd SetupCmdOpts{..} go@GlobalOpts{..} = do (manager,lc) <- loadConfigWithOpts go withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk -> runStackTGlobal manager (lcConfig lc) go $ Docker.reexecWithOptionalContainer (lcProjectRoot lc) Nothing (runStackTGlobal manager (lcConfig lc) go $ Nix.reexecWithOptionalShell (lcProjectRoot lc) globalResolver globalCompiler $ runStackLoggingTGlobal manager go $ do (wantedCompiler, compilerCheck, mstack) <- case scoCompilerVersion of Just v -> return (v, MatchMinor, Nothing) Nothing -> do bc <- lcLoadBuildConfig lc globalCompiler return ( bcWantedCompiler bc , configCompilerCheck (lcConfig lc) , Just $ bcStackYaml bc ) miniConfig <- loadMiniConfig manager (lcConfig lc) mpaths <- runStackTGlobal manager miniConfig go $ ensureCompiler SetupOpts { soptsInstallIfMissing = True , soptsUseSystem = configSystemGHC (lcConfig lc) && not scoForceReinstall , soptsWantedCompiler = wantedCompiler , soptsCompilerCheck = compilerCheck , soptsStackYaml = mstack , soptsForceReinstall = scoForceReinstall , soptsSanityCheck = True , soptsSkipGhcCheck = False , soptsSkipMsys = configSkipMsys $ lcConfig lc , soptsUpgradeCabal = scoUpgradeCabal , soptsResolveMissingGHC = Nothing , soptsStackSetupYaml = scoStackSetupYaml , soptsGHCBindistURL = scoGHCBindistURL } let compiler = case wantedCompiler of GhcVersion _ -> "GHC" GhcjsVersion {} -> "GHCJS" case mpaths of Nothing -> $logInfo $ "stack will use the " <> compiler <> " on your PATH" Just _ -> $logInfo $ "stack will use a locally installed " <> compiler $logInfo "For more information on paths, see 'stack path' and 'stack exec env'" $logInfo $ "To use this " <> compiler <> " and packages outside of a project, consider using:" $logInfo "stack ghc, stack ghci, stack runghc, or stack exec" ) Nothing (Just $ munlockFile lk) -- | Unlock a lock file, if the value is Just munlockFile :: MonadIO m => Maybe FileLock -> m () munlockFile Nothing = return () munlockFile (Just lk) = liftIO $ unlockFile lk -- | Enforce mutual exclusion of every action running via this -- function, on this path, on this users account. -- -- A lock file is created inside the given directory. Currently, -- stack uses locks per-snapshot. In the future, stack may refine -- this to an even more fine-grain locking approach. -- withUserFileLock :: (MonadBaseControl IO m, MonadIO m) => GlobalOpts -> Path Abs Dir -> (Maybe FileLock -> m a) -> m a withUserFileLock go@GlobalOpts{} dir act = do env <- liftIO getEnvironment let toLock = lookup "STACK_LOCK" env == Just "true" if toLock then do let lockfile = $(mkRelFile "lockfile") let pth = dir lockfile ensureDir dir -- Just in case of asynchronous exceptions, we need to be careful -- when using tryLockFile here: EL.bracket (liftIO $ tryLockFile (toFilePath pth) Exclusive) (maybe (return ()) (liftIO . unlockFile)) (\fstTry -> case fstTry of Just lk -> EL.finally (act $ Just lk) (liftIO $ unlockFile lk) Nothing -> do let chatter = globalLogLevel go /= LevelOther "silent" when chatter $ liftIO $ hPutStrLn stderr $ "Failed to grab lock ("++show pth++ "); other stack instance running. Waiting..." EL.bracket (liftIO $ lockFile (toFilePath pth) Exclusive) (liftIO . unlockFile) (\lk -> do when chatter $ liftIO $ hPutStrLn stderr "Lock acquired, proceeding." act $ Just lk)) else act Nothing withConfigAndLock :: GlobalOpts -> StackT Config IO () -> IO () withConfigAndLock go@GlobalOpts{..} inner = do (manager, lc) <- loadConfigWithOpts go withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk -> runStackTGlobal manager (lcConfig lc) go $ Docker.reexecWithOptionalContainer (lcProjectRoot lc) Nothing (runStackTGlobal manager (lcConfig lc) go inner) Nothing (Just $ munlockFile lk) -- | Loads global config, ignoring any configuration which would be -- loaded due to $PWD. withGlobalConfigAndLock :: GlobalOpts -> StackT Config IO () -> IO () withGlobalConfigAndLock go@GlobalOpts{..} inner = do manager <- newTLSManager lc <- runStackLoggingTGlobal manager go $ loadConfigMaybeProject globalConfigMonoid Nothing Nothing withUserFileLock go (configStackRoot $ lcConfig lc) $ \_lk -> runStackTGlobal manager (lcConfig lc) go inner -- For now the non-locking version just unlocks immediately. -- That is, there's still a serialization point. withBuildConfig :: GlobalOpts -> StackT EnvConfig IO () -> IO () withBuildConfig go inner = withBuildConfigAndLock go (\lk -> do munlockFile lk inner) withBuildConfigAndLock :: GlobalOpts -> (Maybe FileLock -> StackT EnvConfig IO ()) -> IO () withBuildConfigAndLock go inner = withBuildConfigExt go Nothing inner Nothing withBuildConfigExt :: GlobalOpts -> Maybe (StackT Config IO ()) -- ^ Action to perform before the build. This will be run on the host -- OS even if Docker is enabled for builds. The build config is not -- available in this action, since that would require build tools to be -- installed on the host OS. -> (Maybe FileLock -> StackT EnvConfig IO ()) -- ^ Action that uses the build config. If Docker is enabled for builds, -- this will be run in a Docker container. -> Maybe (StackT Config IO ()) -- ^ Action to perform after the build. This will be run on the host -- OS even if Docker is enabled for builds. The build config is not -- available in this action, since that would require build tools to be -- installed on the host OS. -> IO () withBuildConfigExt go@GlobalOpts{..} mbefore inner mafter = do (manager, lc) <- loadConfigWithOpts go withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk0 -> do -- A local bit of state for communication between callbacks: curLk <- newIORef lk0 let inner' lk = -- Locking policy: This is only used for build commands, which -- only need to lock the snapshot, not the global lock. We -- trade in the lock here. do dir <- installationRootDeps -- Hand-over-hand locking: withUserFileLock go dir $ \lk2 -> do liftIO $ writeIORef curLk lk2 liftIO $ munlockFile lk inner lk2 let inner'' lk = do bconfig <- runStackLoggingTGlobal manager go $ lcLoadBuildConfig lc globalCompiler envConfig <- runStackTGlobal manager bconfig go (setupEnv Nothing) runStackTGlobal manager envConfig go (inner' lk) runStackTGlobal manager (lcConfig lc) go $ Docker.reexecWithOptionalContainer (lcProjectRoot lc) mbefore (runStackTGlobal manager (lcConfig lc) go $ Nix.reexecWithOptionalShell (lcProjectRoot lc) globalResolver globalCompiler (inner'' lk0)) mafter (Just $ liftIO $ do lk' <- readIORef curLk munlockFile lk') cleanCmd :: CleanOpts -> GlobalOpts -> IO () cleanCmd opts go = withBuildConfigAndLock go (const (clean opts)) -- | Helper for build and install commands buildCmd :: BuildOptsCLI -> GlobalOpts -> IO () buildCmd opts go = do when (any (("-prof" `elem`) . either (const []) id . parseArgs Escaping) (boptsCLIGhcOptions opts)) $ do hPutStrLn stderr "When building with stack, you should not use the -prof GHC option" hPutStrLn stderr "Instead, please use --library-profiling and --executable-profiling" hPutStrLn stderr "See: https://github.com/commercialhaskell/stack/issues/1015" error "-prof GHC option submitted" case boptsCLIFileWatch opts of FileWatchPoll -> fileWatchPoll stderr inner FileWatch -> fileWatch stderr inner NoFileWatch -> inner $ const $ return () where inner setLocalFiles = withBuildConfigAndLock go' $ \lk -> Stack.Build.build setLocalFiles lk opts -- Read the build command from the CLI and enable it to run go' = case boptsCLICommand opts of Test -> set (globalOptsBuildOptsMonoid.buildOptsMonoidTests) (Just True) go Haddock -> set (globalOptsBuildOptsMonoid.buildOptsMonoidHaddock) (Just True) go Bench -> set (globalOptsBuildOptsMonoid.buildOptsMonoidBenchmarks) (Just True) go Install -> set (globalOptsBuildOptsMonoid.buildOptsMonoidInstallExes) (Just True) go Build -> go -- Default case is just Build uninstallCmd :: [String] -> GlobalOpts -> IO () uninstallCmd _ go = withConfigAndLock go $ do $logError "stack does not manage installations in global locations" $logError "The only global mutation stack performs is executable copying" $logError "For the default executable destination, please run 'stack path --local-bin-path'" -- | Unpack packages to the filesystem unpackCmd :: [String] -> GlobalOpts -> IO () unpackCmd names go = withConfigAndLock go $ do menv <- getMinimalEnvOverride Stack.Fetch.unpackPackages menv "." names -- | Update the package index updateCmd :: () -> GlobalOpts -> IO () updateCmd () go = withConfigAndLock go $ getMinimalEnvOverride >>= Stack.PackageIndex.updateAllIndices upgradeCmd :: (Bool, String) -> GlobalOpts -> IO () upgradeCmd (fromGit, repo) go = withGlobalConfigAndLock go $ do upgrade (globalConfigMonoid go) (if fromGit then Just repo else Nothing) (globalResolver go) #ifdef USE_GIT_INFO (find (/= "UNKNOWN") [$gitHash]) #else Nothing #endif -- | Upload to Hackage uploadCmd :: ([String], Maybe PvpBounds, Bool, Bool, String) -> GlobalOpts -> IO () uploadCmd ([], _, _, _, _) _ = error "To upload the current package, please run 'stack upload .'" uploadCmd (args, mpvpBounds, ignoreCheck, don'tSign, sigServerUrl) go = do let partitionM _ [] = return ([], []) partitionM f (x:xs) = do r <- f x (as, bs) <- partitionM f xs return $ if r then (x:as, bs) else (as, x:bs) (files, nonFiles) <- partitionM D.doesFileExist args (dirs, invalid) <- partitionM D.doesDirectoryExist nonFiles unless (null invalid) $ error $ "stack upload expects a list sdist tarballs or cabal directories. Can't find " ++ show invalid let getUploader :: (HasConfig config) => StackT config IO Upload.Uploader getUploader = do config <- asks getConfig manager <- asks envManager let uploadSettings = Upload.setGetManager (return manager) Upload.defaultUploadSettings liftIO $ Upload.mkUploader config uploadSettings withBuildConfigAndLock go $ \_ -> do uploader <- getUploader manager <- asks envManager unless ignoreCheck $ mapM_ (resolveFile' >=> checkSDistTarball) files forM_ files (\file -> do tarFile <- resolveFile' file liftIO (Upload.upload uploader (toFilePath tarFile)) unless don'tSign (void $ Sig.sign manager sigServerUrl tarFile)) unless (null dirs) $ forM_ dirs $ \dir -> do pkgDir <- resolveDir' dir (tarName, tarBytes) <- getSDistTarball mpvpBounds pkgDir unless ignoreCheck $ checkSDistTarball' tarName tarBytes liftIO $ Upload.uploadBytes uploader tarName tarBytes tarPath <- parseRelFile tarName unless don'tSign (void $ Sig.signTarBytes manager sigServerUrl tarPath tarBytes) sdistCmd :: ([String], Maybe PvpBounds, Bool, Bool, String) -> GlobalOpts -> IO () sdistCmd (dirs, mpvpBounds, ignoreCheck, sign, sigServerUrl) go = withBuildConfig go $ do -- No locking needed. -- If no directories are specified, build all sdist tarballs. dirs' <- if null dirs then asks (Map.keys . envConfigPackages . getEnvConfig) else mapM resolveDir' dirs manager <- asks envManager forM_ dirs' $ \dir -> do (tarName, tarBytes) <- getSDistTarball mpvpBounds dir distDir <- distDirFromDir dir tarPath <- (distDir ) <$> parseRelFile tarName ensureDir (parent tarPath) liftIO $ L.writeFile (toFilePath tarPath) tarBytes unless ignoreCheck (checkSDistTarball tarPath) $logInfo $ "Wrote sdist tarball to " <> T.pack (toFilePath tarPath) when sign (void $ Sig.sign manager sigServerUrl tarPath) -- | Execute a command. execCmd :: ExecOpts -> GlobalOpts -> IO () execCmd ExecOpts {..} go@GlobalOpts{..} = case eoExtra of ExecOptsPlain -> do (cmd, args) <- case (eoCmd, eoArgs) of (ExecCmd cmd, args) -> return (cmd, args) (ExecGhc, args) -> return ("ghc", args) (ExecRunGhc, args) -> return ("runghc", args) (manager,lc) <- liftIO $ loadConfigWithOpts go withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk -> runStackTGlobal manager (lcConfig lc) go $ Docker.reexecWithOptionalContainer (lcProjectRoot lc) -- Unlock before transferring control away, whether using docker or not: (Just $ munlockFile lk) (runStackTGlobal manager (lcConfig lc) go $ do config <- asks getConfig menv <- liftIO $ configEnvOverride config plainEnvSettings Nix.reexecWithOptionalShell (lcProjectRoot lc) globalResolver globalCompiler (runStackTGlobal manager (lcConfig lc) go $ exec menv cmd args)) Nothing Nothing -- Unlocked already above. ExecOptsEmbellished {..} -> withBuildConfigAndLock go $ \lk -> do config <- asks getConfig (cmd, args) <- case (eoCmd, eoArgs) of (ExecCmd cmd, args) -> return (cmd, args) (ExecGhc, args) -> execCompiler "" args -- NOTE: this won't currently work for GHCJS, because it doesn't have -- a runghcjs binary. It probably will someday, though. (ExecRunGhc, args) -> execCompiler "run" args let targets = concatMap words eoPackages unless (null targets) $ Stack.Build.build (const $ return ()) lk defaultBuildOptsCLI { boptsCLITargets = map T.pack targets } munlockFile lk -- Unlock before transferring control away. menv <- liftIO $ configEnvOverride config eoEnvSettings exec menv cmd args where execCompiler cmdPrefix args = do wc <- getWhichCompiler let cmd = cmdPrefix ++ compilerExeName wc return (cmd, args) -- | Evaluate some haskell code inline. evalCmd :: EvalOpts -> GlobalOpts -> IO () evalCmd EvalOpts {..} go@GlobalOpts {..} = execCmd execOpts go where execOpts = ExecOpts { eoCmd = ExecGhc , eoArgs = ["-e", evalArg] , eoExtra = evalExtra } -- | Run GHCi in the context of a project. ghciCmd :: GhciOpts -> GlobalOpts -> IO () ghciCmd ghciOpts go@GlobalOpts{..} = withBuildConfigAndLock go $ \lk -> do munlockFile lk -- Don't hold the lock while in the GHCI. bopts <- asks (configBuild . getConfig) -- override env so running of tests and benchmarks is disabled let boptsLocal = bopts { boptsTestOpts = (boptsTestOpts bopts) { toDisableRun = True } , boptsBenchmarkOpts = (boptsBenchmarkOpts bopts) { beoDisableRun = True } } local (set (envEnvConfig.envConfigBuildOpts) boptsLocal) (ghci ghciOpts) -- | Run ide-backend in the context of a project. ideCmd :: ([Text], [String]) -> GlobalOpts -> IO () ideCmd (targets,args) go@GlobalOpts{..} = withBuildConfig go $ -- No locking needed. ide targets args -- | List packages in the project. packagesCmd :: () -> GlobalOpts -> IO () packagesCmd () go@GlobalOpts{..} = withBuildConfig go $ do econfig <- asks getEnvConfig locals <- forM (M.toList (envConfigPackages econfig)) $ \(dir,_) -> do cabalfp <- findOrGenerateCabalFile dir parsePackageNameFromFilePath cabalfp forM_ locals (liftIO . putStrLn . packageNameString) -- | List load targets for a package target. targetsCmd :: Text -> GlobalOpts -> IO () targetsCmd target go@GlobalOpts{..} = withBuildConfig go $ do let boptsCli = defaultBuildOptsCLI { boptsCLITargets = [target] } (_realTargets,_,pkgs) <- ghciSetup (ideGhciOpts boptsCli) pwd <- getCurrentDir targets <- fmap (concat . snd . unzip) (mapM (getPackageOptsAndTargetFiles pwd) pkgs) forM_ targets (liftIO . putStrLn) -- | Pull the current Docker image. dockerPullCmd :: () -> GlobalOpts -> IO () dockerPullCmd _ go@GlobalOpts{..} = do (manager,lc) <- liftIO $ loadConfigWithOpts go -- TODO: can we eliminate this lock if it doesn't touch ~/.stack/? withUserFileLock go (configStackRoot $ lcConfig lc) $ \_ -> runStackTGlobal manager (lcConfig lc) go $ Docker.preventInContainer Docker.pull -- | Reset the Docker sandbox. dockerResetCmd :: Bool -> GlobalOpts -> IO () dockerResetCmd keepHome go@GlobalOpts{..} = do (manager,lc) <- liftIO (loadConfigWithOpts go) -- TODO: can we eliminate this lock if it doesn't touch ~/.stack/? withUserFileLock go (configStackRoot $ lcConfig lc) $ \_ -> runStackTGlobal manager (lcConfig lc) go $ Docker.preventInContainer $ Docker.reset (lcProjectRoot lc) keepHome -- | Cleanup Docker images and containers. dockerCleanupCmd :: Docker.CleanupOpts -> GlobalOpts -> IO () dockerCleanupCmd cleanupOpts go@GlobalOpts{..} = do (manager,lc) <- liftIO $ loadConfigWithOpts go -- TODO: can we eliminate this lock if it doesn't touch ~/.stack/? withUserFileLock go (configStackRoot $ lcConfig lc) $ \_ -> runStackTGlobal manager (lcConfig lc) go $ Docker.preventInContainer $ Docker.cleanup cleanupOpts cfgSetCmd :: ConfigCmd.ConfigCmdSet -> GlobalOpts -> IO () cfgSetCmd co go@GlobalOpts{..} = withBuildConfigAndLock go (\_ -> do env <- ask runReaderT (cfgCmdSet co) env) imgDockerCmd :: (Bool, [Text]) -> GlobalOpts -> IO () imgDockerCmd (rebuild,images) go@GlobalOpts{..} = do mProjectRoot <- lcProjectRoot . snd <$> loadConfigWithOpts go withBuildConfigExt go Nothing (\lk -> do when rebuild $ Stack.Build.build (const (return ())) lk defaultBuildOptsCLI Image.stageContainerImageArtifacts mProjectRoot) (Just $ Image.createContainerImageFromStage mProjectRoot images) -- | Load the configuration with a manager. Convenience function used -- throughout this module. loadConfigWithOpts :: GlobalOpts -> IO (Manager,LoadConfig (StackLoggingT IO)) loadConfigWithOpts go@GlobalOpts{..} = do manager <- newTLSManager mstackYaml <- forM globalStackYaml resolveFile' lc <- runStackLoggingTGlobal manager go $ do lc <- loadConfig globalConfigMonoid globalResolver mstackYaml -- If we have been relaunched in a Docker container, perform in-container initialization -- (switch UID, etc.). We do this after first loading the configuration since it must -- happen ASAP but needs a configuration. case globalDockerEntrypoint of Just de -> Docker.entrypoint (lcConfig lc) de Nothing -> return () return lc return (manager,lc) withMiniConfigAndLock :: GlobalOpts -> StackT MiniConfig IO () -> IO () withMiniConfigAndLock go@GlobalOpts{..} inner = do manager <- newTLSManager miniConfig <- runStackLoggingTGlobal manager go $ do lc <- loadConfigMaybeProject globalConfigMonoid globalResolver Nothing loadMiniConfig manager (lcConfig lc) runStackTGlobal manager miniConfig go inner -- | Project initialization initCmd :: InitOpts -> GlobalOpts -> IO () initCmd initOpts go = do pwd <- getCurrentDir withMiniConfigAndLock go (initProject IsInitCmd pwd initOpts (globalResolver go)) -- | Create a project directory structure and initialize the stack config. newCmd :: (NewOpts,InitOpts) -> GlobalOpts -> IO () newCmd (newOpts,initOpts) go@GlobalOpts{..} = do withMiniConfigAndLock go $ do dir <- new newOpts (forceOverwrite initOpts) initProject IsNewCmd dir initOpts globalResolver -- | List the available templates. templatesCmd :: () -> GlobalOpts -> IO () templatesCmd _ go@GlobalOpts{..} = withConfigAndLock go listTemplates -- | Fix up extra-deps for a project solverCmd :: Bool -- ^ modify stack.yaml automatically? -> GlobalOpts -> IO () solverCmd fixStackYaml go = withBuildConfigAndLock go (\_ -> solveExtraDeps fixStackYaml) -- | Visualize dependencies dotCmd :: DotOpts -> GlobalOpts -> IO () dotCmd dotOpts go = withBuildConfigAndLock go (\_ -> dot dotOpts) -- | List the dependencies listDependenciesCmd :: Text -> GlobalOpts -> IO () listDependenciesCmd sep go = withBuildConfig go (listDependencies sep') where sep' = T.replace "\\t" "\t" (T.replace "\\n" "\n" sep) -- | Query build information queryCmd :: [String] -> GlobalOpts -> IO () queryCmd selectors go = withBuildConfig go $ queryBuildInfo $ map T.pack selectors -- | Generate a combined HPC report hpcReportCmd :: HpcReportOpts -> GlobalOpts -> IO () hpcReportCmd hropts go = withBuildConfig go $ generateHpcReportForTargets hropts data MainException = InvalidReExecVersion String String deriving (Typeable) instance Exception MainException instance Show MainException where show (InvalidReExecVersion expected actual) = concat [ "When re-executing '" , stackProgName , "' in a container, the incorrect version was found\nExpected: " , expected , "; found: " , actual] stack-1.1.2/test/integration/IntegrationSpec.hs0000644000000000000000000001146212711670713017753 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} import Control.Applicative import Control.Arrow import Control.Concurrent.Async import Control.Exception import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Resource import qualified Data.ByteString.Lazy as L import Data.Char import Data.Conduit import Data.Conduit.Binary (sinkLbs) import Data.Conduit.Filesystem (sourceDirectoryDeep) import qualified Data.Conduit.List as CL import Data.Conduit.Process import Data.List (isSuffixOf, stripPrefix, sort) import qualified Data.Map as Map import Data.Text.Encoding.Error (lenientDecode) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL import Data.Typeable import Prelude -- Fix redundant import warnings import System.Directory import System.Environment import System.Exit import System.FilePath import System.IO.Temp import System.PosixCompat.Files import Test.Hspec main :: IO () main = do currDir <- canonicalizePath "test/integration" let findExe name = do mexe <- findExecutable name case mexe of Nothing -> error $ name ++ " not found on PATH" Just exe -> return exe runghc <- findExe "runghc" stack <- findExe "stack" let testDir = currDir "tests" tests <- getDirectoryContents testDir >>= filterM (hasTest testDir) . sort envOrig <- getEnvironment withSystemTempDirectory ("stack-integration-home") $ \newHome -> do let env' = Map.toList $ Map.insert "STACK_EXE" stack $ Map.insert "HOME" newHome $ Map.insert "APPDATA" newHome $ Map.delete "GHC_PACKAGE_PATH" $ Map.fromList $ map (first (map toUpper)) envOrig origStackRoot <- getAppUserDataDirectory "stack" hspec $ mapM_ (test runghc env' currDir origStackRoot newHome) tests hasTest :: FilePath -> FilePath -> IO Bool hasTest root dir = doesFileExist $ root dir "Main.hs" test :: FilePath -- ^ runghc -> [(String, String)] -- ^ env -> FilePath -- ^ currdir -> FilePath -- ^ origStackRoot -> FilePath -- ^ newHome -> String -> Spec test runghc env' currDir origStackRoot newHome name = it name $ withDir $ \dir -> do newHomeExists <- doesDirectoryExist newHome when newHomeExists (removeDirectoryRecursive newHome) copyTree toCopyRoot origStackRoot (newHome takeFileName origStackRoot) let testDir = currDir "tests" name mainFile = testDir "Main.hs" libDir = currDir "lib" cp = (proc runghc [ "-clear-package-db" , "-global-package-db" , "-i" ++ libDir , mainFile ]) { cwd = Just dir , env = Just env' } copyTree (const True) (testDir "files") dir (ClosedStream, outSrc, errSrc, sph) <- streamingProcess cp (out, err, ec) <- runConcurrently $ (,,) <$> Concurrently (outSrc $$ sinkLbs) <*> Concurrently (errSrc $$ sinkLbs) <*> Concurrently (waitForStreamingProcess sph) when (ec /= ExitSuccess) $ throwIO $ TestFailure out err ec where withDir = withSystemTempDirectory ("stack-integration-" ++ name) data TestFailure = TestFailure L.ByteString L.ByteString ExitCode deriving Typeable instance Show TestFailure where show (TestFailure out err ec) = concat [ "Exited with " ++ show ec , "\n\nstdout:\n" , toStr out , "\n\nstderr:\n" , toStr err ] where toStr = TL.unpack . TL.decodeUtf8With lenientDecode instance Exception TestFailure copyTree :: (FilePath -> Bool) -> FilePath -> FilePath -> IO () copyTree toCopy src dst = runResourceT (sourceDirectoryDeep False src $$ CL.mapM_ go) `catch` \(_ :: IOException) -> return () where go srcfp = when (toCopy srcfp) $ liftIO $ do Just suffix <- return $ stripPrefix src srcfp let dstfp = dst ++ "/" ++ suffix createDirectoryIfMissing True $ takeDirectory dstfp createSymbolicLink srcfp dstfp `catch` \(_ :: IOException) -> copyFile srcfp dstfp -- for Windows toCopyRoot :: FilePath -> Bool toCopyRoot srcfp = any (`isSuffixOf` srcfp) -- FIXME command line parameters to control how many of these get -- copied, trade-off of runtime/bandwidth vs isolation of tests [ ".tar" , ".xz" -- , ".gz" , ".7z.exe" , "00-index.cache" ] stack-1.1.2/test/integration/lib/StackTest.hs0000644000000000000000000000752712712355472017342 0ustar0000000000000000module StackTest where import Control.Exception import Data.List (intercalate) import System.Environment import System.FilePath import System.Directory import System.IO import System.Process import System.Exit import System.Info (os) run' :: FilePath -> [String] -> IO ExitCode run' cmd args = do logInfo $ "Running: " ++ cmd ++ " " ++ intercalate " " (map showProcessArgDebug args) (Nothing, Nothing, Nothing, ph) <- createProcess (proc cmd args) waitForProcess ph run :: FilePath -> [String] -> IO () run cmd args = do ec <- run' cmd args if ec == ExitSuccess then return () else error $ "Exited with exit code: " ++ show ec stack' :: [String] -> IO ExitCode stack' args = do stack <- getEnv "STACK_EXE" run' stack args stack :: [String] -> IO () stack args = do ec <- stack' args if ec == ExitSuccess then return () else error $ "Exited with exit code: " ++ show ec stackErr :: [String] -> IO () stackErr args = do ec <- stack' args if ec == ExitSuccess then error "stack was supposed to fail, but didn't" else return () -- | Run stack with arguments and apply a check to the resulting -- stderr output if the process succeeded. stackCheckStderr :: [String] -> (String -> IO ()) -> IO () stackCheckStderr args check = do stack <- getEnv "STACK_EXE" logInfo $ "Running: " ++ stack ++ " " ++ intercalate " " (map showProcessArgDebug args) (ec, _, err) <- readProcessWithExitCode stack args "" hPutStr stderr err if ec /= ExitSuccess then error $ "Exited with exit code: " ++ show ec else check err doesNotExist :: FilePath -> IO () doesNotExist fp = do logInfo $ "doesNotExist " ++ fp exists <- doesFileOrDirExist fp case exists of (Right msg) -> error msg (Left _) -> return () doesExist :: FilePath -> IO () doesExist fp = do logInfo $ "doesExist " ++ fp exists <- doesFileOrDirExist fp case exists of (Right msg) -> return () (Left _) -> error "No file or directory exists" doesFileOrDirExist :: FilePath -> IO (Either () String) doesFileOrDirExist fp = do isFile <- doesFileExist fp if isFile then return (Right ("File exists: " ++ fp)) else do isDir <- doesDirectoryExist fp if isDir then return (Right ("Directory exists: " ++ fp)) else return (Left ()) copy :: FilePath -> FilePath -> IO () copy src dest = do logInfo ("Copy " ++ show src ++ " to " ++ show dest) System.Directory.copyFile src dest fileContentsMatch :: FilePath -> FilePath -> IO () fileContentsMatch f1 f2 = do doesExist f1 doesExist f2 f1Contents <- readFile f1 f2Contents <- readFile f2 if f1Contents == f2Contents then return () else error ("contents do not match for " ++ show f1 ++ " " ++ show f2) logInfo :: String -> IO () logInfo = hPutStrLn stderr -- TODO: use stack's process running utilties? (better logging) -- for now just copy+modifying this one from System.Process.Log -- | Show a process arg including speechmarks when necessary. Just for -- debugging purposes, not functionally important. showProcessArgDebug :: String -> String showProcessArgDebug x | any special x = show x | otherwise = x where special '"' = True special ' ' = True special _ = False -- | Extension of executables exeExt = if isWindows then ".exe" else "" -- | Is the OS Windows? isWindows = os == "mingw32" -- | Is the OS Mac OS X? isMacOSX = os == "darwin" -- | To avoid problems with GHC version mismatch when a new LTS major -- version is released, pass this argument to @stack@ when running in -- a global context. The LTS major version here should match that of -- the main @stack.yaml@. defaultResolverArg = "--resolver=lts-5" stack-1.1.2/src/test/Test.hs0000644000000000000000000000011612531336731014031 0ustar0000000000000000import Test.Hspec (hspec) import Spec (spec) main :: IO () main = hspec spec stack-1.1.2/src/test/Spec.hs0000644000000000000000000000010512531336731014002 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-} stack-1.1.2/src/test/Stack/BuildPlanSpec.hs0000644000000000000000000001202412717707441016653 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} module Stack.BuildPlanSpec where import Stack.BuildPlan import Control.Monad.Logger import Control.Exception hiding (try) import Control.Monad.Catch (try) import Data.Monoid import qualified Data.Map as Map import qualified Data.Set as Set import Network.HTTP.Conduit (Manager) import Prelude -- Fix redundant import warnings import System.Directory import System.Environment import System.IO.Temp (withSystemTempDirectory) import Test.Hspec import Stack.Config import Stack.Types import Stack.Types.StackT data T = T { manager :: Manager } setup :: IO T setup = do manager <- newTLSManager unsetEnv "STACK_YAML" return T{..} teardown :: T -> IO () teardown _ = return () main :: IO () main = hspec spec spec :: Spec spec = beforeAll setup $ afterAll teardown $ do let logLevel = LevelDebug let loadConfig' m = runStackLoggingT m logLevel False False (loadConfig mempty Nothing Nothing) let loadBuildConfigRest m = runStackLoggingT m logLevel False False let inTempDir action = do currentDirectory <- getCurrentDirectory withSystemTempDirectory "Stack_BuildPlanSpec" $ \tempDir -> do let enterDir = setCurrentDirectory tempDir let exitDir = setCurrentDirectory currentDirectory bracket_ enterDir exitDir action it "finds missing transitive dependencies #159" $ \T{..} -> inTempDir $ do -- Note: this test is somewhat fragile, depending on packages on -- Hackage remaining in a certain state. If it fails, confirm that -- github still depends on failure. writeFile "stack.yaml" "resolver: lts-2.9" LoadConfig{..} <- loadConfig' manager bconfig <- loadBuildConfigRest manager (lcLoadBuildConfig Nothing) runStackT manager logLevel bconfig False False $ do mbp <- loadMiniBuildPlan $ LTS 2 9 eres <- try $ resolveBuildPlan mbp (const False) (Map.fromList [ ($(mkPackageName "github"), Set.empty) ]) case eres of Left (UnknownPackages _ unknown _) -> do case Map.lookup $(mkPackageName "github") unknown of Nothing -> error "doesn't list github as unknown" Just _ -> return () {- Currently not implemented, see: https://github.com/fpco/stack/issues/159#issuecomment-107809418 case Map.lookup $(mkPackageName "failure") unknown of Nothing -> error "failure not listed" Just _ -> return () -} _ -> error $ "Unexpected result from resolveBuildPlan: " ++ show eres return () describe "shadowMiniBuildPlan" $ do let version = $(mkVersion "1.0.0") -- unimportant for this test pn = either throw id . parsePackageNameFromString mkMPI deps = MiniPackageInfo { mpiVersion = version , mpiFlags = Map.empty , mpiGhcOptions = [] , mpiPackageDeps = Set.fromList $ map pn $ words deps , mpiToolDeps = Set.empty , mpiExes = Set.empty , mpiHasLibrary = True , mpiGitSHA1 = Nothing } go x y = (pn x, mkMPI y) resourcet = go "resourcet" "" conduit = go "conduit" "resourcet" conduitExtra = go "conduit-extra" "conduit" text = go "text" "" attoparsec = go "attoparsec" "text" aeson = go "aeson" "text attoparsec" mkMBP pkgs = MiniBuildPlan { mbpCompilerVersion = GhcVersion version , mbpPackages = Map.fromList pkgs } mbpAll = mkMBP [resourcet, conduit, conduitExtra, text, attoparsec, aeson] test name input shadowed output extra = it name $ const $ shadowMiniBuildPlan input (Set.fromList $ map pn $ words shadowed) `shouldBe` (output, Map.fromList extra) test "no shadowing" mbpAll "" mbpAll [] test "shadow something that isn't there" mbpAll "does-not-exist" mbpAll [] test "shadow a leaf" mbpAll "conduit-extra" (mkMBP [resourcet, conduit, text, attoparsec, aeson]) [] test "shadow direct dep" mbpAll "conduit" (mkMBP [resourcet, text, attoparsec, aeson]) [conduitExtra] test "shadow deep dep" mbpAll "resourcet" (mkMBP [text, attoparsec, aeson]) [conduit, conduitExtra] test "shadow deep dep and leaf" mbpAll "resourcet aeson" (mkMBP [text, attoparsec]) [conduit, conduitExtra] test "shadow deep dep and direct dep" mbpAll "resourcet conduit" (mkMBP [text, attoparsec, aeson]) [conduitExtra] stack-1.1.2/src/test/Stack/Build/ExecuteSpec.hs0000644000000000000000000000020512565175366017446 0ustar0000000000000000module Stack.Build.ExecuteSpec (main, spec) where import Test.Hspec main :: IO () main = hspec spec spec :: Spec spec = return () stack-1.1.2/src/test/Stack/Build/TargetSpec.hs0000644000000000000000000000200312562412670017255 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Stack.Build.TargetSpec (main, spec) where import qualified Data.Text as T import Stack.Build.Target import Stack.Types import Test.Hspec main :: IO () main = hspec spec spec :: Spec spec = do describe "parseRawTarget" $ do let test s e = it s $ parseRawTarget (T.pack s) `shouldBe` e test "foobar" $ Just $ RTPackage $(mkPackageName "foobar") test "foobar-1.2.3" $ Just $ RTPackageIdentifier $ PackageIdentifier $(mkPackageName "foobar") $(mkVersion "1.2.3") test "./foobar" Nothing test "foobar/" Nothing test "/foobar" Nothing test ":some-exe" $ Just $ RTComponent "some-exe" test "foobar:some-exe" $ Just $ RTPackageComponent $(mkPackageName "foobar") $ UnresolvedComponent "some-exe" test "foobar:exe:some-exe" $ Just $ RTPackageComponent $(mkPackageName "foobar") $ ResolvedComponent $ CExe "some-exe" stack-1.1.2/src/test/Stack/ConfigSpec.hs0000644000000000000000000001325212670025006016176 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} module Stack.ConfigSpec where import Control.Applicative import Control.Monad.Logger import Control.Exception import Data.Maybe import Data.Monoid import Network.HTTP.Conduit (Manager) import Path import Path.IO --import System.FilePath import Prelude -- Fix redundant import warnings import System.Directory import System.Environment import System.IO.Temp (withSystemTempDirectory) import Test.Hspec import Stack.Config import Stack.Types.Config import Stack.Types.StackT sampleConfig :: String sampleConfig = "resolver: lts-2.10\n" ++ "packages: ['.']\n" buildOptsConfig :: String buildOptsConfig = "resolver: lts-2.10\n" ++ "packages: ['.']\n" ++ "build:\n" ++ " library-profiling: true\n" ++ " executable-profiling: true\n" ++ " haddock: true\n" ++ " haddock-deps: true\n" ++ " copy-bins: true\n" ++ " prefetch: true\n" ++ " force-dirty: true\n" ++ " keep-going: true\n" ++ " test: true\n" ++ " test-arguments:\n" ++ " rerun-tests: true\n" ++ " additional-args: ['-fprof']\n" ++ " coverage: true\n" ++ " no-run-tests: true\n" ++ " bench: true\n" ++ " benchmark-opts:\n" ++ " benchmark-arguments: -O2\n" ++ " no-run-benchmarks: true\n" ++ " reconfigure: true\n" ++ " cabal-verbose: true\n" stackDotYaml :: Path Rel File stackDotYaml = $(mkRelFile "stack.yaml") data T = T { manager :: Manager } setup :: IO T setup = do manager <- newTLSManager unsetEnv "STACK_YAML" return T{..} teardown :: T -> IO () teardown _ = return () noException :: Selector SomeException noException = const False spec :: Spec spec = beforeAll setup $ afterAll teardown $ do let logLevel = LevelDebug -- TODO(danburton): not use inTempDir let inTempDir action = do currentDirectory <- getCurrentDirectory withSystemTempDirectory "Stack_ConfigSpec" $ \tempDir -> do let enterDir = setCurrentDirectory tempDir let exitDir = setCurrentDirectory currentDirectory bracket_ enterDir exitDir action -- TODO(danburton): a safer version of this? let withEnvVar name newValue action = do originalValue <- fromMaybe "" <$> lookupEnv name let setVar = setEnv name newValue let resetVar = setEnv name originalValue bracket_ setVar resetVar action describe "loadConfig" $ do let loadConfig' m = runStackLoggingT m logLevel False False (loadConfig mempty Nothing Nothing) let loadBuildConfigRest m = runStackLoggingT m logLevel False False -- TODO(danburton): make sure parent dirs also don't have config file it "works even if no config file exists" $ \T{..} -> example $ do _config <- loadConfig' manager return () it "works with a blank config file" $ \T{..} -> inTempDir $ do writeFile (toFilePath stackDotYaml) "" -- TODO(danburton): more specific test for exception loadConfig' manager `shouldThrow` anyException it "parses build config options" $ \T{..} -> inTempDir $ do writeFile (toFilePath stackDotYaml) buildOptsConfig BuildOpts{..} <- configBuild . lcConfig <$> loadConfig' manager boptsLibProfile `shouldBe` True boptsExeProfile `shouldBe` True boptsHaddock `shouldBe` True boptsHaddockDeps `shouldBe` (Just True) boptsInstallExes `shouldBe` True boptsPreFetch `shouldBe` True boptsKeepGoing `shouldBe` (Just True) boptsForceDirty `shouldBe` True boptsTests `shouldBe` True boptsTestOpts `shouldBe` (TestOpts {toRerunTests = True ,toAdditionalArgs = ["-fprof"] ,toCoverage = True ,toDisableRun = True}) boptsBenchmarks `shouldBe` True boptsBenchmarkOpts `shouldBe` (BenchmarkOpts {beoAdditionalArgs = Just "-O2" ,beoDisableRun = True}) boptsReconfigure `shouldBe` True boptsCabalVerbose `shouldBe` True it "finds the config file in a parent directory" $ \T{..} -> inTempDir $ do writeFile (toFilePath stackDotYaml) sampleConfig parentDir <- getCurrentDirectory >>= parseAbsDir let childDir = "child" createDirectory childDir setCurrentDirectory childDir LoadConfig{..} <- loadConfig' manager bc@BuildConfig{..} <- loadBuildConfigRest manager (lcLoadBuildConfig Nothing) bcRoot bc `shouldBe` parentDir it "respects the STACK_YAML env variable" $ \T{..} -> inTempDir $ do withSystemTempDir "config-is-here" $ \dir -> do let stackYamlFp = toFilePath (dir stackDotYaml) writeFile stackYamlFp sampleConfig withEnvVar "STACK_YAML" stackYamlFp $ do LoadConfig{..} <- loadConfig' manager BuildConfig{..} <- loadBuildConfigRest manager (lcLoadBuildConfig Nothing) bcStackYaml `shouldBe` dir stackDotYaml parent bcStackYaml `shouldBe` dir it "STACK_YAML can be relative" $ \T{..} -> inTempDir $ do parentDir <- getCurrentDirectory >>= parseAbsDir let childRel = $(mkRelDir "child") yamlRel = childRel $(mkRelFile "some-other-name.config") yamlAbs = parentDir yamlRel createDirectoryIfMissing True $ toFilePath $ parent yamlAbs writeFile (toFilePath yamlAbs) "resolver: ghc-7.8" withEnvVar "STACK_YAML" (toFilePath yamlRel) $ do LoadConfig{..} <- loadConfig' manager BuildConfig{..} <- loadBuildConfigRest manager (lcLoadBuildConfig Nothing) bcStackYaml `shouldBe` yamlAbs stack-1.1.2/src/test/Stack/DotSpec.hs0000644000000000000000000001253212644245454015533 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} -- | Test suite for Stack.Dot module Stack.DotSpec where import Control.Monad (filterM) import Data.Foldable as F import Data.Functor.Identity import Data.List ((\\)) import qualified Data.Map as Map import Data.Maybe (fromMaybe) import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import Stack.Types import Test.Hspec import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (forAll,choose,Gen) import Stack.Dot dummyVersion :: Version dummyVersion = fromMaybe (error "dotspec: parser error") (parseVersionFromString "0.0.0.0") spec :: Spec spec = do let graph = Map.mapKeys pkgName . fmap (\p -> (Set.map pkgName p, Just dummyVersion)) . Map.fromList $ [("one",Set.fromList ["base","free"]) ,("two",Set.fromList ["base","free","mtl","transformers","one"]) ] describe "Stack.Dot" $ do it "does nothing if depth is 0" $ resolveDependencies (Just 0) graph stubLoader `shouldBe` return graph it "with depth 1, more dependencies are resolved" $ do let graph' = Map.insert (pkgName "cycle") (Set.singleton (pkgName "cycle"), Just dummyVersion) graph resultGraph = runIdentity (resolveDependencies (Just 0) graph stubLoader) resultGraph' = runIdentity (resolveDependencies (Just 1) graph' stubLoader) Map.size resultGraph < Map.size resultGraph' `shouldBe` True it "cycles are ignored" $ do let graph' = Map.insert (pkgName "cycle") (Set.singleton (pkgName "cycle"), Just dummyVersion) graph resultGraph = resolveDependencies Nothing graph stubLoader resultGraph' = resolveDependencies Nothing graph' stubLoader fmap Map.size resultGraph' `shouldBe` fmap ((+1) . Map.size) resultGraph let graphElem e = Set.member e . Set.unions . Map.elems prop "requested packages are pruned" $ do let resolvedGraph = runIdentity (resolveDependencies Nothing graph stubLoader) allPackages g = Set.map show (Map.keysSet g `Set.union` F.fold (fmap fst g)) forAll (sublistOf (Set.toList (allPackages resolvedGraph))) $ \toPrune -> let pruned = pruneGraph [pkgName "one", pkgName "two"] toPrune resolvedGraph in Set.null (allPackages pruned `Set.intersection` Set.fromList toPrune) prop "pruning removes orhpans" $ do let resolvedGraph = runIdentity (resolveDependencies Nothing graph stubLoader) allPackages g = Set.map show (Map.keysSet g `Set.union` F.fold (fmap fst g)) orphans g = Map.filterWithKey (\k _ -> not (graphElem k g)) g forAll (sublistOf (Set.toList (allPackages resolvedGraph))) $ \toPrune -> let pruned = pruneGraph [pkgName "one", pkgName "two"] toPrune resolvedGraph in null (Map.keys (orphans (fmap fst pruned)) \\ [pkgName "one", pkgName "two"]) {- Helper functions below -} -- Backport from QuickCheck 2.8 to 2.7.6 sublistOf :: [a] -> Gen [a] sublistOf = filterM (\_ -> choose (False, True)) -- Unsafe internal helper to create a package name pkgName :: Text -> PackageName pkgName = fromMaybe failure . parsePackageName where failure = error "Internal error during package name creation in DotSpec.pkgName" -- Stub, simulates the function to load package dependecies stubLoader :: PackageName -> Identity (Set PackageName, Maybe Version) stubLoader name = return . (, Just dummyVersion) . Set.fromList . map pkgName $ case show name of "StateVar" -> ["stm","transformers"] "array" -> [] "bifunctors" -> ["semigroupoids","semigroups","tagged"] "binary" -> ["array","bytestring","containers"] "bytestring" -> ["deepseq","ghc-prim","integer-gmp"] "comonad" -> ["containers","contravariant","distributive" ,"semigroups","tagged","transformers","transformers-compat" ] "cont" -> ["StateVar","semigroups","transformers","transformers-compat","void"] "containers" -> ["array","deepseq","ghc-prim"] "deepseq" -> ["array"] "distributive" -> ["ghc-prim","tagged","transformers","transformers-compat"] "free" -> ["bifunctors","comonad","distributive","mtl" ,"prelude-extras","profunctors","semigroupoids" ,"semigroups","template-haskell","transformers" ] "ghc" -> [] "hashable" -> ["bytestring","ghc-prim","integer-gmp","text"] "integer" -> [] "mtl" -> ["transformers"] "nats" -> [] "one" -> ["free"] "prelude" -> [] "profunctors" -> ["comonad","distributive","semigroupoids","tagged","transformers"] "semigroupoids" -> ["comonad","containers","contravariant","distributive" ,"semigroups","transformers","transformers-compat" ] "semigroups" -> ["bytestring","containers","deepseq","hashable" ,"nats","text","unordered-containers" ] "stm" -> ["array"] "tagged" -> ["template-haskell"] "template" -> [] "text" -> ["array","binary","bytestring","deepseq","ghc-prim","integer-gmp"] "transformers" -> [] "two" -> ["free","mtl","one","transformers"] "unordered" -> ["deepseq","hashable"] "void" -> ["ghc-prim","hashable","semigroups"] _ -> [] stack-1.1.2/src/test/Stack/PackageDumpSpec.hs0000644000000000000000000002554312644245454017174 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} module Stack.PackageDumpSpec where import Data.Conduit import qualified Data.Conduit.List as CL import qualified Data.Conduit.Binary as CB import Data.Conduit.Text (decodeUtf8) import Control.Monad.Trans.Resource (runResourceT) import Stack.PackageDump import Stack.Types import Test.Hspec import Test.Hspec.QuickCheck import System.Process.Read import Control.Monad.Logger import Distribution.System (buildPlatform) import qualified Data.Map as Map import Data.Map (Map) import qualified Data.Set as Set main :: IO () main = hspec spec spec :: Spec spec = do describe "eachSection" $ do let test name content expected = it name $ do actual <- yield content $$ eachSection CL.consume =$ CL.consume actual `shouldBe` expected test "unix line endings" "foo\nbar\n---\nbaz---\nbin\n---\n" [ ["foo", "bar"] , ["baz---", "bin"] ] test "windows line endings" "foo\r\nbar\r\n---\r\nbaz---\r\nbin\r\n---\r\n" [ ["foo", "bar"] , ["baz---", "bin"] ] it "eachPair" $ do let bss = [ "key1: val1" , "key2: val2a" , " val2b" , "key3:" , "key4:" , " val4a" , " val4b" ] sink k = fmap (k, ) CL.consume actual <- mapM_ yield bss $$ eachPair sink =$ CL.consume actual `shouldBe` [ ("key1", ["val1"]) , ("key2", ["val2a", "val2b"]) , ("key3", []) , ("key4", ["val4a", "val4b"]) ] describe "conduitDumpPackage" $ do it "ghc 7.8" $ do haskell2010:_ <- runResourceT $ CB.sourceFile "test/package-dump/ghc-7.8.txt" =$= decodeUtf8 $$ conduitDumpPackage =$ CL.consume ghcPkgId <- parseGhcPkgId "haskell2010-1.1.2.0-05c8dd51009e08c6371c82972d40f55a" packageIdent <- parsePackageIdentifier "haskell2010-1.1.2.0" depends <- mapM parseGhcPkgId [ "array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b" , "base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1" , "ghc-prim-0.3.1.0-a24f9c14c632d75b683d0f93283aea37" ] haskell2010 `shouldBe` DumpPackage { dpGhcPkgId = ghcPkgId , dpPackageIdent = packageIdent , dpLibDirs = ["/opt/ghc/7.8.4/lib/ghc-7.8.4/haskell2010-1.1.2.0"] , dpDepends = depends , dpLibraries = ["HShaskell2010-1.1.2.0"] , dpHasExposedModules = True , dpHaddockInterfaces = ["/opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskell2010-1.1.2.0/haskell2010.haddock"] , dpHaddockHtml = Just "/opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskell2010-1.1.2.0" , dpProfiling = () , dpHaddock = () , dpIsExposed = False } it "ghc 7.10" $ do haskell2010:_ <- runResourceT $ CB.sourceFile "test/package-dump/ghc-7.10.txt" =$= decodeUtf8 $$ conduitDumpPackage =$ CL.consume ghcPkgId <- parseGhcPkgId "ghc-7.10.1-325809317787a897b7a97d646ceaa3a3" pkgIdent <- parsePackageIdentifier "ghc-7.10.1" depends <- mapM parseGhcPkgId [ "array-0.5.1.0-e29cdbe82692341ebb7ce6e2798294f9" , "base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a" , "bin-package-db-0.0.0.0-708fc7d634a370b311371a5bcde40b62" , "bytestring-0.10.6.0-0909f8f31271f3d75749190bf2ee35db" , "containers-0.5.6.2-2114032c163425cc264e6e1169dc2f6d" , "directory-1.2.2.0-b4959b472d9eee380c6b32291ade29e0" , "filepath-1.4.0.0-40d643aa87258c186441a1f8f3e13ca6" , "hoopl-3.10.0.2-8c8dfc4c3140e5f7c982da224c3cb1f0" , "hpc-0.6.0.2-ac9064885aa8cb08a93314222939ead4" , "process-1.2.3.0-3b1e9bca6ac38225806ff7bbf3f845b1" , "template-haskell-2.10.0.0-e895139a0ffff267d412e3d0191ce93b" , "time-1.5.0.1-e17a9220d438435579d2914e90774246" , "transformers-0.4.2.0-c1a7bb855a176fe475d7b665301cd48f" , "unix-2.7.1.0-e5915eb989e568b732bc7286b0d0817f" ] haskell2010 `shouldBe` DumpPackage { dpGhcPkgId = ghcPkgId , dpPackageIdent = pkgIdent , dpLibDirs = ["/opt/ghc/7.10.1/lib/ghc-7.10.1/ghc_EMlWrQ42XY0BNVbSrKixqY"] , dpHaddockInterfaces = ["/opt/ghc/7.10.1/share/doc/ghc/html/libraries/ghc-7.10.1/ghc.haddock"] , dpHaddockHtml = Just "/opt/ghc/7.10.1/share/doc/ghc/html/libraries/ghc-7.10.1" , dpDepends = depends , dpLibraries = ["HSghc-7.10.1-EMlWrQ42XY0BNVbSrKixqY"] , dpHasExposedModules = True , dpProfiling = () , dpHaddock = () , dpIsExposed = False } it "ghc 7.8.4 (osx)" $ do hmatrix:_ <- runResourceT $ CB.sourceFile "test/package-dump/ghc-7.8.4-osx.txt" =$= decodeUtf8 $$ conduitDumpPackage =$ CL.consume ghcPkgId <- parseGhcPkgId "hmatrix-0.16.1.5-12d5d21f26aa98774cdd8edbc343fbfe" pkgId <- parsePackageIdentifier "hmatrix-0.16.1.5" depends <- mapM parseGhcPkgId [ "array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b" , "base-4.7.0.2-918c7ac27f65a87103264a9f51652d63" , "binary-0.7.1.0-108d06eea2ef05e517f9c1facf10f63c" , "bytestring-0.10.4.0-78bc8f2c724c765c78c004a84acf6cc3" , "deepseq-1.3.0.2-0ddc77716bd2515426e1ba39f6788a4f" , "random-1.1-822c19b7507b6ac1aaa4c66731e775ae" , "split-0.2.2-34cfb851cc3784e22bfae7a7bddda9c5" , "storable-complex-0.2.2-e962c368d58acc1f5b41d41edc93da72" , "vector-0.10.12.3-f4222db607fd5fdd7545d3e82419b307"] hmatrix `shouldBe` DumpPackage { dpGhcPkgId = ghcPkgId , dpPackageIdent = pkgId , dpLibDirs = [ "/Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/lib/x86_64-osx-ghc-7.8.4/hmatrix-0.16.1.5" , "/opt/local/lib/" , "/usr/local/lib/" , "C:/Program Files/Example/"] , dpHaddockInterfaces = ["/Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/doc/html/hmatrix.haddock"] , dpHaddockHtml = Just "/Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/doc/html" , dpDepends = depends , dpLibraries = ["HShmatrix-0.16.1.5"] , dpHasExposedModules = True , dpProfiling = () , dpHaddock = () , dpIsExposed = True } it "ghc HEAD" $ do ghcBoot:_ <- runResourceT $ CB.sourceFile "test/package-dump/ghc-head.txt" =$= decodeUtf8 $$ conduitDumpPackage =$ CL.consume ghcPkgId <- parseGhcPkgId "ghc-boot-0.0.0.0" pkgId <- parsePackageIdentifier "ghc-boot-0.0.0.0" depends <- mapM parseGhcPkgId [ "base-4.9.0.0" , "binary-0.7.5.0" , "bytestring-0.10.7.0" , "directory-1.2.5.0" , "filepath-1.4.1.0" ] ghcBoot `shouldBe` DumpPackage { dpGhcPkgId = ghcPkgId , dpPackageIdent = pkgId , dpLibDirs = ["/opt/ghc/head/lib/ghc-7.11.20151213/ghc-boot-0.0.0.0"] , dpHaddockInterfaces = ["/opt/ghc/head/share/doc/ghc/html/libraries/ghc-boot-0.0.0.0/ghc-boot.haddock"] , dpHaddockHtml = Just "/opt/ghc/head/share/doc/ghc/html/libraries/ghc-boot-0.0.0.0" , dpDepends = depends , dpLibraries = ["HSghc-boot-0.0.0.0"] , dpHasExposedModules = True , dpProfiling = () , dpHaddock = () , dpIsExposed = True } it "ghcPkgDump + addProfiling + addHaddock" $ (id :: IO () -> IO ()) $ runNoLoggingT $ do menv' <- getEnvOverride buildPlatform menv <- mkEnvOverride buildPlatform $ Map.delete "GHC_PACKAGE_PATH" $ unEnvOverride menv' icache <- newInstalledCache ghcPkgDump menv Ghc [] $ conduitDumpPackage =$ addProfiling icache =$ addHaddock icache =$ CL.sinkNull it "sinkMatching" $ do menv' <- getEnvOverride buildPlatform menv <- mkEnvOverride buildPlatform $ Map.delete "GHC_PACKAGE_PATH" $ unEnvOverride menv' icache <- newInstalledCache m <- runNoLoggingT $ ghcPkgDump menv Ghc [] $ conduitDumpPackage =$ addProfiling icache =$ addHaddock icache =$ sinkMatching False False (Map.singleton $(mkPackageName "transformers") $(mkVersion "0.0.0.0.0.0.1")) case Map.lookup $(mkPackageName "base") m of Nothing -> error "base not present" Just _ -> return () Map.lookup $(mkPackageName "transformers") m `shouldBe` Nothing Map.lookup $(mkPackageName "ghc") m `shouldBe` Nothing describe "pruneDeps" $ do it "sanity check" $ do let prunes = [ ((1, 'a'), []) , ((1, 'b'), []) , ((2, 'a'), [(1, 'b')]) , ((2, 'b'), [(1, 'a')]) , ((3, 'a'), [(1, 'c')]) , ((4, 'a'), [(2, 'a')]) ] actual = fmap fst $ pruneDeps fst fst snd bestPrune prunes actual `shouldBe` Map.fromList [ (1, (1, 'b')) , (2, (2, 'a')) , (4, (4, 'a')) ] prop "invariant holds" $ \prunes' -> -- Force uniqueness let prunes = Map.toList $ Map.fromList prunes' in checkDepsPresent prunes $ fmap fst $ pruneDeps fst fst snd bestPrune prunes type PruneCheck = ((Int, Char), [(Int, Char)]) bestPrune :: PruneCheck -> PruneCheck -> PruneCheck bestPrune x y | fst x > fst y = x | otherwise = y checkDepsPresent :: [PruneCheck] -> Map Int (Int, Char) -> Bool checkDepsPresent prunes selected = all hasDeps $ Set.toList allIds where depMap = Map.fromList prunes allIds = Set.fromList $ Map.elems selected hasDeps ident = case Map.lookup ident depMap of Nothing -> error "checkDepsPresent: missing in depMap" Just deps -> Set.null $ Set.difference (Set.fromList deps) allIds stack-1.1.2/src/test/Stack/ArgsSpec.hs0000644000000000000000000001370012707670645015703 0ustar0000000000000000-- | Args parser test suite. module Stack.ArgsSpec where import Control.Applicative import Control.Exception.Base (assert) import Control.Monad import Data.Attoparsec.Interpreter (interpreterArgsParser) import qualified Data.Attoparsec.Text as P import Data.Text (pack) import Options.Applicative.Args import Stack.Constants (stackProgName) import Test.Hspec -- | Test spec. spec :: Spec spec = do argsSpec interpreterArgsSpec argsSpec :: Spec argsSpec = forM_ argsInputOutput (\(input,output) -> it input (parseArgsFromString input == output)) -- | Fairly comprehensive checks. argsInputOutput :: [(String, Either String [String])] argsInputOutput = [ ("x", Right ["x"]) , ("x y z", Right ["x", "y", "z"]) , ("aaa bbb ccc", Right ["aaa", "bbb", "ccc"]) , (" aaa bbb ccc ", Right ["aaa", "bbb", "ccc"]) , ("aaa\"", Left "unterminated string: endOfInput") , ("\"", Left "unterminated string: endOfInput") , ("\"\"", Right [""]) , ("\"aaa", Left "unterminated string: endOfInput") , ("\"aaa\" bbb ccc \"ddd\"", Right ["aaa", "bbb", "ccc", "ddd"]) , ("\"aa\\\"a\" bbb ccc \"ddd\"", Right ["aa\"a", "bbb", "ccc", "ddd"]) , ("\"aa\\\"a\" bb\\b ccc \"ddd\"", Right ["aa\"a", "bb\\b", "ccc", "ddd"]) , ("\"\" \"\" c", Right ["","","c"])] interpreterArgsSpec :: Spec interpreterArgsSpec = describe "Script interpreter parser" $ do describe "Success cases" $ do describe "Line comments" $ do checkLines "" checkLines " --x" checkLines " --x --y" describe "Literate line comments" $ do checkLiterateLines "" checkLiterateLines " --x" checkLiterateLines " --x --y" describe "Block comments" $ do checkBlocks "" checkBlocks "\n" checkBlocks " --x" checkBlocks "\n--x" checkBlocks " --x --y" checkBlocks "\n--x\n--y" checkBlocks "\n\t--x\n\t--y" describe "Literate block comments" $ do checkLiterateBlocks "" "" checkLiterateBlocks "\n>" "" checkLiterateBlocks " --x" " --x" checkLiterateBlocks "\n>--x" "--x" checkLiterateBlocks " --x --y " "--x --y" checkLiterateBlocks "\n>--x\n>--y" "--x --y" checkLiterateBlocks "\n>\t--x\n>\t--y" "--x --y" describe "Failure cases" $ do checkFailures describe "Bare directives in literate files" $ do forM_ (interpreterGenValid lineComment []) $ testAndCheck (acceptFailure True) [] forM_ (interpreterGenValid blockComment []) $ testAndCheck (acceptFailure True) [] where parse isLiterate s = P.parseOnly (interpreterArgsParser isLiterate stackProgName) (pack s) acceptSuccess :: Bool -> String -> String -> Bool acceptSuccess isLiterate args s = case parse isLiterate s of Right x | words x == words args -> True _ -> False acceptFailure isLiterate _ s = case parse isLiterate s of Left _ -> True Right _ -> False showInput i = "BEGIN =>" ++ i ++ "<= END" testAndCheck checker out inp = it (showInput inp) $ checker out inp checkLines args = forM_ (interpreterGenValid lineComment args) (testAndCheck (acceptSuccess False) args) checkLiterateLines args = forM_ (interpreterGenValid literateLineComment args) (testAndCheck (acceptSuccess True) args) checkBlocks args = forM_ (interpreterGenValid blockComment args) (testAndCheck (acceptSuccess False) args) checkLiterateBlocks inp args = forM_ (interpreterGenValid literateBlockComment inp) (testAndCheck (acceptSuccess True) args) checkFailures = forM_ interpreterGenInvalid (testAndCheck (acceptFailure False) "unused") -- Generate a set of acceptable inputs for given format and args interpreterGenValid fmt args = shebang <++> newLine <++> (fmt args) interpreterGenInvalid :: [String] -- Generate a set of Invalid inputs interpreterGenInvalid = ["-stack\n"] -- random input -- just the shebang <|> shebang <++> ["\n"] -- invalid shebang <|> blockSpace <++> [head (interpreterGenValid lineComment args)] -- something between shebang and stack comment <|> shebang <++> newLine <++> blockSpace <++> ([head (lineComment args)] <|> [head (blockComment args)]) -- unterminated block comment -- just chop the closing chars from a valid block comment <|> shebang <++> ["\n"] <++> let c = head (blockComment args) l = length c - 2 in [assert (drop l c == "-}") (take l c)] -- nested block comment <|> shebang <++> ["\n"] <++> [head (blockComment "--x {- nested -} --y")] where args = " --x --y" (<++>) = liftA2 (++) -- Generative grammar for the interpreter comments shebang = ["#!/usr/bin/env stack"] newLine = ["\n"] <|> ["\r\n"] -- A comment may be the last line or followed by something else postComment = [""] <|> newLine -- A command starts with zero or more whitespace followed by "stack" makeComment maker space args = let makePrefix s = (s <|> [""]) <++> [stackProgName] in (maker <$> ((makePrefix space) <++> [args])) <++> postComment lineSpace = [" "] <|> ["\t"] lineComment = makeComment makeLine lineSpace where makeLine s = "--" ++ s literateLineComment = makeComment ("> --" ++) lineSpace blockSpace = lineSpace <|> newLine blockComment = makeComment makeBlock blockSpace where makeBlock s = "{-" ++ s ++ "-}" literateBlockComment = makeComment (\s -> "> {-" ++ s ++ "-}") (lineSpace <|> map (++ ">") newLine) stack-1.1.2/src/test/Stack/NixSpec.hs0000644000000000000000000000403112706265473015540 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell, OverloadedStrings #-} module Stack.NixSpec where import Control.Exception import Control.Monad.Logger import Data.Monoid import Network.HTTP.Conduit (Manager) import Path import Prelude -- to remove the warning about Data.Monoid being redundant on GHC 7.10 import Stack.Config import Stack.Config.Nix import Stack.Types.Config import Stack.Types.Nix import Stack.Types.StackT import System.Directory import System.Environment import System.IO.Temp (withSystemTempDirectory) import Test.Hspec sampleConfig :: String sampleConfig = "resolver: lts-2.10\n" ++ "packages: ['.']\n" ++ "nix:\n" ++ " enable: True\n" ++ " packages: [glpk]" stackDotYaml :: Path Rel File stackDotYaml = $(mkRelFile "stack.yaml") data T = T { manager :: Manager } setup :: IO T setup = do manager <- newTLSManager unsetEnv "STACK_YAML" return T{..} teardown :: T -> IO () teardown _ = return () spec :: Spec spec = beforeAll setup $ afterAll teardown $ do let loadConfig' m = runStackLoggingT m LevelDebug False False (loadConfig mempty Nothing Nothing) inTempDir action = do currentDirectory <- getCurrentDirectory withSystemTempDirectory "Stack_ConfigSpec" $ \tempDir -> do let enterDir = setCurrentDirectory tempDir exitDir = setCurrentDirectory currentDirectory bracket_ enterDir exitDir action describe "nix" $ do it "sees that the nix shell is enabled" $ \T{..} -> inTempDir $ do writeFile (toFilePath stackDotYaml) sampleConfig lc <- loadConfig' manager (nixEnable $ configNix $ lcConfig lc) `shouldBe` True it "sees that the only package asked for is glpk and adds GHC from nixpkgs mirror of LTS resolver" $ \T{..} -> inTempDir $ do writeFile (toFilePath stackDotYaml) sampleConfig lc <- loadConfig' manager (nixPackages $ configNix $ lcConfig lc) `shouldBe` ["glpk"] nixCompiler (lcConfig lc) Nothing Nothing `shouldBe` "haskell.packages.lts-2_10.ghc" stack-1.1.2/src/test/Network/HTTP/Download/VerifiedSpec.hs0000644000000000000000000001367612717707441021466 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} module Network.HTTP.Download.VerifiedSpec where import Crypto.Hash import Control.Monad (unless) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Logger (LoggingT, runStdoutLoggingT) import Control.Monad.Trans.Reader import Control.Retry (limitRetries) import Data.Maybe import Network.HTTP.Client.Conduit import Network.HTTP.Download.Verified import Path import Path.IO import Test.Hspec hiding (shouldNotBe, shouldNotReturn) -- TODO: share across test files withTempDir' :: (Path Abs Dir -> IO a) -> IO a withTempDir' = withSystemTempDir "NHD_VerifiedSpec" -- | An example path to download the exampleReq. getExamplePath :: Path Abs Dir -> IO (Path Abs File) getExamplePath dir = do file <- parseRelFile "cabal-install-1.22.4.0.tar.gz" return (dir file) -- | An example DownloadRequest that uses a SHA1 exampleReq :: DownloadRequest exampleReq = fromMaybe (error "exampleReq") $ do req <- parseUrl "http://download.fpcomplete.com/stackage-cli/linux64/cabal-install-1.22.4.0.tar.gz" return DownloadRequest { drRequest = req , drHashChecks = [exampleHashCheck] , drLengthCheck = Just exampleLengthCheck , drRetryPolicy = limitRetries 1 } exampleHashCheck :: HashCheck exampleHashCheck = HashCheck { hashCheckAlgorithm = SHA1 , hashCheckHexDigest = CheckHexDigestString "b98eea96d321cdeed83a201c192dac116e786ec2" } exampleLengthCheck :: LengthCheck exampleLengthCheck = 302513 -- | The wrong ContentLength for exampleReq exampleWrongContentLength :: Int exampleWrongContentLength = 302512 -- | The wrong SHA1 digest for exampleReq exampleWrongDigest :: CheckHexDigest exampleWrongDigest = CheckHexDigestString "b98eea96d321cdeed83a201c192dac116e786ec3" exampleWrongContent :: String exampleWrongContent = "example wrong content" isWrongContentLength :: VerifiedDownloadException -> Bool isWrongContentLength WrongContentLength{} = True isWrongContentLength _ = False isWrongDigest :: VerifiedDownloadException -> Bool isWrongDigest WrongDigest{} = True isWrongDigest _ = False data T = T { manager :: Manager } runWith :: MonadIO m => Manager -> ReaderT Manager (LoggingT m) r -> m r runWith manager = runStdoutLoggingT . flip runReaderT manager setup :: IO T setup = do manager <- newManager return T{..} teardown :: T -> IO () teardown _ = return () shouldNotBe :: (Show a, Eq a) => a -> a -> Expectation actual `shouldNotBe` expected = unless (actual /= expected) (expectationFailure msg) where msg = "Value was exactly what it shouldn't be: " ++ show expected shouldNotReturn :: (Show a, Eq a) => IO a -> a -> Expectation action `shouldNotReturn` unexpected = action >>= (`shouldNotBe` unexpected) spec :: Spec spec = beforeAll setup $ afterAll teardown $ do let exampleProgressHook _ = return () describe "verifiedDownload" $ do -- Preconditions: -- * the exampleReq server is running -- * the test runner has working internet access to it it "downloads the file correctly" $ \T{..} -> withTempDir' $ \dir -> do examplePath <- getExamplePath dir doesFileExist examplePath `shouldReturn` False let go = runWith manager $ verifiedDownload exampleReq examplePath exampleProgressHook go `shouldReturn` True doesFileExist examplePath `shouldReturn` True it "is idempotent, and doesn't redownload unnecessarily" $ \T{..} -> withTempDir' $ \dir -> do examplePath <- getExamplePath dir doesFileExist examplePath `shouldReturn` False let go = runWith manager $ verifiedDownload exampleReq examplePath exampleProgressHook go `shouldReturn` True doesFileExist examplePath `shouldReturn` True go `shouldReturn` False doesFileExist examplePath `shouldReturn` True -- https://github.com/commercialhaskell/stack/issues/372 it "does redownload when the destination file is wrong" $ \T{..} -> withTempDir' $ \dir -> do examplePath <- getExamplePath dir let exampleFilePath = toFilePath examplePath writeFile exampleFilePath exampleWrongContent doesFileExist examplePath `shouldReturn` True readFile exampleFilePath `shouldReturn` exampleWrongContent let go = runWith manager $ verifiedDownload exampleReq examplePath exampleProgressHook go `shouldReturn` True doesFileExist examplePath `shouldReturn` True readFile exampleFilePath `shouldNotReturn` exampleWrongContent it "rejects incorrect content length" $ \T{..} -> withTempDir' $ \dir -> do examplePath <- getExamplePath dir let wrongContentLengthReq = exampleReq { drLengthCheck = Just exampleWrongContentLength } let go = runWith manager $ verifiedDownload wrongContentLengthReq examplePath exampleProgressHook go `shouldThrow` isWrongContentLength doesFileExist examplePath `shouldReturn` False it "rejects incorrect digest" $ \T{..} -> withTempDir' $ \dir -> do examplePath <- getExamplePath dir let wrongHashCheck = exampleHashCheck { hashCheckHexDigest = exampleWrongDigest } let wrongDigestReq = exampleReq { drHashChecks = [wrongHashCheck] } let go = runWith manager $ verifiedDownload wrongDigestReq examplePath exampleProgressHook go `shouldThrow` isWrongDigest doesFileExist examplePath `shouldReturn` False -- https://github.com/commercialhaskell/stack/issues/240 it "can download hackage tarballs" $ \T{..} -> withTempDir' $ \dir -> do dest <- fmap (dir ) $ parseRelFile "acme-missiles-0.3.tar.gz" req <- parseUrl "http://hackage.haskell.org/package/acme-missiles-0.3/acme-missiles-0.3.tar.gz" let dReq = DownloadRequest { drRequest = req , drHashChecks = [] , drLengthCheck = Nothing , drRetryPolicy = limitRetries 1 } let go = runWith manager $ verifiedDownload dReq dest exampleProgressHook doesFileExist dest `shouldReturn` False go `shouldReturn` True doesFileExist dest `shouldReturn` True stack-1.1.2/LICENSE0000644000000000000000000000273112661616322012023 0ustar0000000000000000Copyright (c) 2015-2016, Stack contributors All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of stack nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL STACK CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. stack-1.1.2/Setup.hs0000644000000000000000000000005612610164614012444 0ustar0000000000000000import Distribution.Simple main = defaultMain stack-1.1.2/stack.cabal0000644000000000000000000002440700000000000013047 0ustar0000000000000000name: stack version: 1.1.2 cabal-version: >=1.10 build-type: Simple license: BSD3 license-file: LICENSE maintainer: manny@fpcomplete.com homepage: http://haskellstack.org synopsis: The Haskell Tool Stack description: Please see the README.md for usage information, and the wiki on Github for more details. Also, note that the API for the library is not currently stable, and may change significantly, even between minor releases. It is currently only intended for use by the executable. category: Development author: Commercial Haskell SIG extra-source-files: CONTRIBUTING.md ChangeLog.md README.md doc/*.md test/package-dump/ghc-7.8.txt test/package-dump/ghc-7.8.4-osx.txt test/package-dump/ghc-7.10.txt stack.yaml source-repository head type: git location: https://github.com/commercialhaskell/stack.git flag integration-tests description: Run the integration test suite default: False manual: True flag disable-git-info description: Disable compile-time inclusion of current git info in stack default: False manual: True flag static description: Pass -static/-pthread to ghc when linking the stack binary. default: False manual: True library if os(windows) build-depends: Win32 >=2.3.1.0 && <2.4 cpp-options: -DWINDOWS else build-depends: unix >=2.7.0.1 && <2.8 exposed-modules: Control.Concurrent.Execute Data.Aeson.Extended Data.Attoparsec.Args Data.Attoparsec.Combinators Data.Attoparsec.Interpreter Data.Binary.VersionTagged Data.IORef.RunOnce Data.Maybe.Extra Data.Monoid.Extra Distribution.Version.Extra Network.HTTP.Download Network.HTTP.Download.Verified Options.Applicative.Args Options.Applicative.Builder.Extra Options.Applicative.Complicated Path.Extra Path.Find Paths_stack Stack.Build Stack.Build.Cache Stack.Build.ConstructPlan Stack.Build.Execute Stack.Build.Haddock Stack.Build.Installed Stack.Build.Source Stack.Build.Target Stack.BuildPlan Stack.Clean Stack.Config Stack.Config.Build Stack.Config.Urls Stack.Config.Docker Stack.Config.Nix Stack.ConfigCmd Stack.Constants Stack.Coverage Stack.Docker Stack.Docker.GlobalDB Stack.Dot Stack.Exec Stack.Fetch Stack.FileWatch Stack.GhcPkg Stack.Ghci Stack.Ide Stack.Image Stack.Init Stack.New Stack.Nix Stack.Options Stack.Package Stack.PackageDump Stack.PackageIndex Stack.SDist Stack.Setup Stack.Setup.Installed Stack.Sig Stack.Sig.GPG Stack.Sig.Sign Stack.Solver Stack.Types Stack.Types.Build Stack.Types.BuildPlan Stack.Types.Urls Stack.Types.Compiler Stack.Types.Config Stack.Types.Config.Build Stack.Types.Docker Stack.Types.FlagName Stack.Types.GhcPkgId Stack.Types.Image Stack.Types.Internal Stack.Types.Nix Stack.Types.Package Stack.Types.PackageIdentifier Stack.Types.PackageIndex Stack.Types.PackageName Stack.Types.Sig Stack.Types.StackT Stack.Types.TemplateName Stack.Types.Version Stack.Upgrade Stack.Upload System.Process.Log System.Process.PagerEditor System.Process.Read System.Process.Run build-depends: Cabal >=1.18.1.5 && <1.25, aeson >=0.8.0.2 && <0.10 || ==0.11.*, ansi-terminal >=0.6.2.3 && <0.7, async >=2.0.2 && <2.2, attoparsec >=0.12.1.5 && <0.14, base >=4.7 && <5, base-compat >=0.6 && <0.10, base16-bytestring >=0.1.1.6 && <0.2, base64-bytestring >=1.0.0.1 && <1.1, binary ==0.7.*, binary-tagged >=0.1.1 && <0.2, blaze-builder >=0.4.0.2 && <0.5, byteable >=0.1.1 && <0.2, bytestring >=0.10.6.0 && <0.11, conduit >=1.2.4 && <1.3, conduit-extra >=1.1.7.1 && <1.2, containers >=0.5.5.1 && <0.6, cryptohash >=0.11.6 && <0.12, cryptohash-conduit >=0.1.1 && <0.2, directory >=1.2.1.0 && <1.3, edit-distance ==0.2.*, either >=4.4.1.1 && <4.5, enclosed-exceptions >=1.0.1.1 && <1.1, errors >=2.1.2 && <2.2, exceptions >=0.8.0.2 && <0.9, extra >=1.4.6 && <1.5, fast-logger >=2.3.1 && <2.5, filelock >=0.1.0.1 && <0.2, filepath >=1.3.0.2 && <1.5, fsnotify >=0.2.1 && <0.3, generic-deriving >=1.9.0 && <1.10, hashable >=1.2.3.2 && <1.3, hit >=0.6.3 && <0.7, hpc >=0.6.0.2 && <0.7, http-client >=0.4.17 && <0.5, http-client-tls >=0.2.2 && <0.3, http-conduit >=2.1.7 && <2.2, http-types >=0.8.6 && <0.10, lifted-base >=0.2.3.6 && <0.3, microlens >=0.3.0.0 && <0.5, monad-control >=1.0.1.0 && <1.1, monad-logger >=0.3.13.1 && <0.4, monad-unlift >=0.1.2.0 && <0.2, mtl >=2.1.3.1 && <2.3, open-browser >=0.2.1 && <0.3, optparse-applicative >=0.11 && <0.13, path >=0.5.1 && <0.6, path-io >=1.1.0 && <2.0.0, persistent >=2.1.2 && <2.6, persistent-sqlite >=2.1.4 && <2.6, persistent-template >=2.1.1 && <2.6, pretty >=1.1.1.1 && <1.2, process >=1.2.0.0 && <1.3, regex-applicative-text >=0.1.0.1 && <0.2, resourcet >=1.1.4.1 && <1.2, retry >=0.6 && <0.8, safe ==0.3.*, semigroups >=0.5 && <0.19, split >=0.2.3.1 && <0.3, stm >=2.4.4 && <2.5, streaming-commons >=0.1.10.0 && <0.2, tar >=0.4.1.0 && <0.6, template-haskell >=2.9.0.0 && <2.11, temporary >=1.2.0.3 && <1.3, text >=1.2.0.4 && <1.3, text-binary >=0.2.1 && <0.3, time >=1.4.2 && <1.6, tls >=1.3.8 && <1.4, transformers >=0.3.0.0 && <0.5, transformers-base >=0.4.4 && <0.5, unix-compat >=0.4.1.4 && <0.5, unordered-containers >=0.2.5.1 && <0.3, vector >=0.10.12.3 && <0.12, vector-binary-instances >=0.2.3.2 && <0.3, yaml >=0.8.10.1 && <0.9, zlib >=0.5.4.2 && <0.7, deepseq ==1.4.*, hastache >=0.6.1 && <0.7, project-template ==0.2.*, zip-archive >=0.2.3.7 && <0.3, hpack >=0.14.0 && <0.15 default-language: Haskell2010 hs-source-dirs: src/ ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates executable stack if flag(static) ld-options: -static -pthread if os(windows) build-depends: Win32 >=2.3.1.0 && <2.4 cpp-options: -DWINDOWS if !flag(disable-git-info) build-depends: gitrev >=1.1 && <1.3, optparse-simple >=0.0.3 && <0.1 cpp-options: -DUSE_GIT_INFO main-is: Main.hs build-depends: Cabal >=1.18.1.5 && <1.25, base >=4.7 && <5, bytestring >=0.10.4.0 && <0.11, containers >=0.5.5.1 && <0.6, directory >=1.2.2.0 && <1.3, filelock >=0.1.0.1 && <0.2, filepath >=1.4.0.0 && <1.5, http-client >=0.4.28 && <0.5, lifted-base >=0.2.3.6 && <0.3, microlens >=0.3.0.0 && <0.5, monad-control >=1.0.1.0 && <1.1, monad-logger >=0.3.13.1 && <0.4, mtl >=2.1.3.1 && <2.3, optparse-applicative >=0.11.0.2 && <0.13, path >=0.5.7 && <0.6, path-io >=1.1.0 && <2.0.0, stack >=1.1.2 && <1.2, text >=1.2.0.4 && <1.3, transformers >=0.4.2.0 && <0.5 default-language: Haskell2010 hs-source-dirs: src/main other-modules: Paths_stack ghc-options: -threaded -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates test-suite stack-test type: exitcode-stdio-1.0 main-is: Test.hs build-depends: Cabal >=1.18.1.5 && <1.25, QuickCheck >=2.8.1 && <2.9, attoparsec >=0.13.0.2 && <0.14, base >=4.7 && <5, conduit >=1.2.6.6 && <1.3, conduit-extra >=1.1.13.1 && <1.2, containers >=0.5.5.1 && <0.6, cryptohash >=0.11.6 && <0.12, directory >=1.2.2.0 && <1.3, exceptions >=0.8.2.1 && <0.9, hspec >=2.2.3 && <2.3, http-conduit >=2.1.10.1 && <2.2, monad-logger >=0.3.18 && <0.4, path >=0.5.7 && <0.6, path-io >=1.1.0 && <2.0.0, resourcet >=1.1.7.4 && <1.2, retry >=0.6 && <0.8, stack >=1.1.2 && <1.2, temporary >=1.2.0.4 && <1.3, text >=1.2.2.1 && <1.3, transformers >=0.4.2.0 && <0.5 default-language: Haskell2010 hs-source-dirs: src/test other-modules: Spec Stack.BuildPlanSpec Stack.Build.ExecuteSpec Stack.Build.TargetSpec Stack.ConfigSpec Stack.DotSpec Stack.PackageDumpSpec Stack.ArgsSpec Stack.NixSpec Network.HTTP.Download.VerifiedSpec ghc-options: -threaded -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates test-suite stack-integration-test if !flag(integration-tests) buildable: False type: exitcode-stdio-1.0 main-is: IntegrationSpec.hs build-depends: async >=2.1.0 && <2.2, base >=4.7 && <5, bytestring >=0.10.6.0 && <0.11, conduit >=1.2.6.6 && <1.3, conduit-extra >=1.1.13.1 && <1.2, containers >=0.5.5.1 && <0.6, directory >=1.2.2.0 && <1.3, filepath >=1.4.0.0 && <1.5, hspec >=2.2.3 && <2.3, process >=1.2.3.0 && <1.3, resourcet >=1.1.7.4 && <1.2, temporary >=1.2.0.4 && <1.3, text >=1.2.2.1 && <1.3, transformers >=0.4.2.0 && <0.5, unix-compat >=0.4.1.4 && <0.5 default-language: Haskell2010 hs-source-dirs: test/integration test/integration/lib other-modules: StackTest ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates stack-1.1.2/CONTRIBUTING.md0000644000000000000000000000722012717707440013251 0ustar0000000000000000# Contributors Guide ## Bug Reports Before reporting a bug, please ensure that you are using the latest release (currently stack-1.1.2). See the [upgrade instructions](http://docs.haskellstack.org/en/stable/install_and_upgrade/#upgrade) to upgrade. When reporting a bug, please write in the following format: > [Any general summary/comments if desired] > **Steps to reproduce:** > 1. _Remove directory *blah*._ > 2. _Run command `stack blah`._ > 3. _Edit file blah._ > 3. _Run command `stack blah`._ > **Expected:** > _What I expected to see and happen._ > **Actual:** > _What actually happened._ > > Here is the `stack --version` output: > > ``` > $ stack --version > Version 0.0.2, Git revision 6a86ee32e5b869a877151f74064572225e1a0398 > ``` > Here is the command I ran **with `--verbose`**: > > ``` > $ stack --verbose > > ``` With `--verbose` mode we can see what the tool is doing and when. Without this output it is much more difficult to surmise what's going on with your issue. If the above output is larger than a page, paste it in a private [Gist](https://gist.github.com/) instead. Include any `.yaml` configuration if relevant. The more detailed your report, the faster it can be resolved and will ensure it is resolved in the right way. Once your bug has been resolved, the responsible will tag the issue as _Needs confirmation_ and assign the issue back to you. Once you have tested and confirmed that the issue is resolved, close the issue. If you are not a member of the project, you will be asked for confirmation and we will close it. ## Documentation If you would like to help with documentation, please note that for most cases the Wiki has been deprecated in favor of markdown files placed in a new `/doc` subdirectory of the repository itself. Please submit a [pull request](https://help.github.com/articles/using-pull-requests/) with your changes/additions. The documentation is rendered on [haskellstack.org](http://haskellstack.org) by readthedocs.org using Sphinx and CommonMark. Since links and formatting vary from GFM, please check the documentation there before submitting a PR to fix those. In particular, links to other documentation files intentionally have `.html` extensions instead of `.md`, unfortunately (see [#1506](https://github.com/commercialhaskell/stack/issues/1506) for details). If your changes move or rename files, or subsume Wiki content, please continue to leave a file/page in the old location temporarily, in addition to the new location. This will allow users time to update any shared links to the old location. Please also update any links in other files, or on the Wiki, to point to the new file location. ## Code If you would like to contribute code to fix a bug, add a new feature, or otherwise improve `stack`, pull requests are most welcome. It's a good idea to [submit an issue](https://github.com/commercialhaskell/stack/issues/new) to discuss the change before plowing into writing code. If you'd like to help out but aren't sure what to work on, look for issues with the [awaiting pr](https://github.com/commercialhaskell/stack/issues?q=is%3Aopen+is%3Aissue+label%3A%22awaiting+pr%22) label. Issues that are suitable for newcomers to the codebase have the [newcomer](https://github.com/commercialhaskell/stack/issues?q=is%3Aopen+is%3Aissue+label%3A%22awaiting+pr%22+label%3Anewcomer) label. Best to post a comment to the issue before you start work, in case anyone has already started. Please include a [ChangeLog](https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md) entry and [documentation](https://github.com/commercialhaskell/stack/tree/master/doc/) updates with your pull request. stack-1.1.2/ChangeLog.md0000644000000000000000000014007212717707440013174 0ustar0000000000000000# Changelog ## 1.1.2 Release notes: * Official FreeBSD binaries are [now available](http://docs.haskellstack.org/en/stable/install_and_upgrade/#freebsd) [#1253](https://github.com/commercialhaskell/stack/issues/1253). Major changes: * Extensible custom snapshots implemented. These allow you to define snapshots which extend other snapshots. See [#863](https://github.com/commercialhaskell/stack/issues/863). Local file custom snapshots can now be safely updated without changing their name. Remote custom snapshots should still be treated as immutable. Behavior changes: * `stack path --compiler` was added in the last release, to yield a path to the compiler. Unfortunately, `--compiler` is a global option that is useful to use with `stack path`. The same functionality is now provided by `stack path --compiler-exe`. See [#2123](https://github.com/commercialhaskell/stack/issues/2123) * For packages specified in terms of a git or hg repo, the hash used in the location has changed. This means that existing downloads from older stack versions won't be used. This is a side-effect of the fix to [#2133](https://github.com/commercialhaskell/stack/issues/2133) * `stack upgrade` no longer pays attention to local stack.yaml files, just the global config and CLI options. [#1392](https://github.com/commercialhaskell/stack/issues/1392) * `stack ghci` now uses `:add` instead of `:load`, making it potentially work better with user scripts. See [#1888](https://github.com/commercialhaskell/stack/issues/1888) Other enhancements: * Grab Cabal files via Git SHA to avoid regressions from Hackage revisions [#2070](https://github.com/commercialhaskell/stack/pull/2070) * Custom snapshots now support `ghc-options`. * Package git repos are now re-used rather than re-cloned. See [#1620](https://github.com/commercialhaskell/stack/issues/1620) * `DESTDIR` is filtered from environment when installing GHC. See [#1460](https://github.com/commercialhaskell/stack/issues/1460) * `stack haddock` now supports `--hadock-arguments`. See [#2144](https://github.com/commercialhaskell/stack/issues/2144) * Signing: warn if GPG_TTY is not set as per `man gpg-agent` Bug fixes: * Now ignore project config when doing `stack init` or `stack new`. See [#2110](https://github.com/commercialhaskell/stack/issues/2110) * Packages specified by git repo can now have submodules. See [#2133](https://github.com/commercialhaskell/stack/issues/2133) * Fix of hackage index fetch retry. See re-opening of [#1418](https://github.com/commercialhaskell/stack/issues/1418#issuecomment-217633843) * HPack now picks up changes to filesystem other than package.yaml. See [#2051](https://github.com/commercialhaskell/stack/issues/2051) * "stack solver" no longer suggests --omit-packages. See [#2031](https://github.com/commercialhaskell/stack/issues/2031) * Fixed an issue with building Cabal's Setup.hs. See [#1356](https://github.com/commercialhaskell/stack/issues/1356) * Package dirtiness now pays attention to deleted files. See [#1841](https://github.com/commercialhaskell/stack/issues/1841) * `stack ghci` now uses `extra-lib-dirs` and `extra-include-dirs`. See [#1656](https://github.com/commercialhaskell/stack/issues/1656) * Relative paths outside of source dir added via `qAddDependentFile` are now checked for dirtiness. See [#1982](https://github.com/commercialhaskell/stack/issues/1982) * Signing: always use `--with-fingerprints` ## 1.1.0 Release notes: * Added Ubuntu 16.04 LTS (xenial) Apt repo. * No longer uploading new versions to Fedora 21 repo. Behavior changes: * Snapshot packages are no longer built with executable profiling. See [#1179](https://github.com/commercialhaskell/stack/issues/1179). * `stack init` now ignores symlinks when searching for cabal files. It also now ignores any directory that begins with `.` (as well as `dist` dirs) - before it would only ignore `.git`, `.stack-work`, and `dist`. * The stack executable is no longer built with `-rtsopts`. Before, when `-rtsopts` was enabled, stack would process `+RTS` options even when intended for some other program, such as when used with `stack exec -- prog +RTS`. See [#2022](https://github.com/commercialhaskell/stack/issues/2022). * The `stack path --ghc-paths` option is deprecated and renamed to `--programs`. `--compiler` is added, which points directly at the compiler used in the current project. `--compiler-bin` points to the compiler's bin dir. * For consistency with the `$STACK_ROOT` environment variable, the `stack path --global-stack-root` flag and the `global-stack-root` field in the output of `stack path` are being deprecated and replaced with the `stack-root` flag and output field. Additionally, the stack root can now be specified via the `--stack-root` command-line flag. See [#1148](https://github.com/commercialhaskell/stack/issues/1148). * `stack sig` GPG-related sub-commands were removed (folded into `upload` and `sdist`) * GPG signing of packages while uploading to Hackage is now the default. Use `upload --no-signature` if you would rather not contribute your package signature. If you don't yet have a GPG keyset, read this [blog post on GPG keys](https://fpcomplete.com/blog/2016/05/stack-security-gnupg-keys). We can add a stack.yaml config setting to disable signing if some people desire it. We hope that people will sign. Later we will be adding GPG signature verification options. * `stack build pkg-1.2.3` will now build even if the snapshot has a different package version - it is treated as an extra-dep. `stack build local-pkg-1.2.3` is an error even if the version number matches the local package [#2028](https://github.com/commercialhaskell/stack/issues/2028). * Having a `nix:` section no longer implies enabling nix build. This allows the user to globally configure whether nix is used (unless the project overrides the default explicitly). See [#1924](https://github.com/commercialhaskell/stack/issues/1924). * Remove deprecated valid-wanted field. * Docker: mount home directory in container [#1949](https://github.com/commercialhaskell/stack/issues/1949). * Deprecate `--local-bin-path` instead `--local-bin`. * `stack image`: allow absolute source paths for `add`. Other enhancements: * `stack haddock --open [PACKAGE]` opens the local haddocks in the browser. * Fix too much rebuilding when enabling/disabling profiling flags. * `stack build pkg-1.0` will now build `pkg-1.0` even if the snapshot specifies a different version (it introduces a temporary extra-dep) * Experimental support for `--split-objs` added [#1284](https://github.com/commercialhaskell/stack/issues/1284). * `git` packages with submodules are supported by passing the `--recursive` flag to `git clone`. * When using [hpack](https://github.com/sol/hpack), only regenerate cabal files when hpack files change. * hpack files can now be used in templates * `stack ghci` now runs ghci as a separate process [#1306](https://github.com/commercialhaskell/stack/issues/1306) * Retry when downloading snapshots and package indices * Many build options are configurable now in `stack.yaml`: ``` build: library-profiling: true executable-profiling: true haddock: true haddock-deps: true copy-bins: true prefetch: true force-dirty: true keep-going: true test: true test-arguments: rerun-tests: true additional-args: ['-fprof'] coverage: true no-run-tests: true bench: true benchmark-opts: benchmark-arguments: -O2 no-run-benchmarks: true reconfigure: true cabal-verbose: true ``` * A number of URLs are now configurable, useful for firewalls. See [#1794](https://github.com/commercialhaskell/stack/issues/1884). * Suggest causes when executables are missing. * Allow `--omit-packages` even without `--solver`. * Improve the generated stack.yaml. * Improve ghci results after :load Main module collision with main file path. * Only load the hackage index if necessary [#1883](https://github.com/commercialhaskell/stack/issues/1883), [#1892](https://github.com/commercialhaskell/stack/issues/1892). * init: allow local packages to be deps of deps [#1965](https://github.com/commercialhaskell/stack/issues/1965). * Always use full fingerprints from GPG [#1952](https://github.com/commercialhaskell/stack/issues/1952). * Default to using `gpg2` and fall back to `gpg` [#1976](https://github.com/commercialhaskell/stack/issues/1976). * Add a flag for --verbosity silent. * Add `haddock --open` flag [#1396](https://github.com/commercialhaskell/stack/issues/1396). Bug fixes: * Package tarballs would fail to unpack. [#1884](https://github.com/commercialhaskell/stack/issues/1884). * Fixed errant warnings about missing modules, after deleted and removed from cabal file [#921](https://github.com/commercialhaskell/stack/issues/921) [#1805](https://github.com/commercialhaskell/stack/issues/1805). * Now considers a package to dirty when the hpack file is changed [#1819](https://github.com/commercialhaskell/stack/issues/1819). * Nix: cancelling a stack build now exits properly rather than dropping into a nix-shell [#1778](https://github.com/commercialhaskell/stack/issues/1778). * `allow-newer: true` now causes `--exact-configuration` to be passed to Cabal. See [#1579](https://github.com/commercialhaskell/stack/issues/1579). * `stack solver` no longer fails with `InvalidRelFile` for relative package paths including `..`. See [#1954](https://github.com/commercialhaskell/stack/issues/1954). * Ignore emacs lock files when finding .cabal [#1897](https://github.com/commercialhaskell/stack/issues/1897). * Use lenient UTF-8 decode for build output [#1945](https://github.com/commercialhaskell/stack/issues/1945). * Clear index cache whenever index updated [#1962](https://github.com/commercialhaskell/stack/issues/1962). * Fix: Building a container image drops a .stack-work dir in the current working (sub)directory [#1975](https://github.com/commercialhaskell/stack/issues/1975). * Fix: Rebuilding when disabling profiling [#2023](https://github.com/commercialhaskell/stack/issues/2023). ## 1.0.4.3 Bug fixes: * Don't delete contents of ~/.ssh when using `stack clean --full` with Docker enabled [#2000](https://github.com/commercialhaskell/stack/issues/2000) ## 1.0.4.2 Build with path-io-1.0.0. There are no changes in behaviour from 1.0.4, so no binaries are released for this version. ## 1.0.4.1 Fixes build with aeson-0.11.0.0. There are no changes in behaviour from 1.0.4, so no binaries are released for this version. ## 1.0.4 Major changes: * Some notable changes in `stack init`: * Overall it should now be able to initialize almost all existing cabal packages out of the box as long as the package itself is consistently defined. * Choose the best possible snapshot and add extra dependencies on top of a snapshot resolver rather than a compiler resolver - [#1583](https://github.com/commercialhaskell/stack/pull/1583) * Automatically omit a package (`--omit-packages`) when it is compiler incompatible or when there are packages with conflicting dependency requirements - [#1674](https://github.com/commercialhaskell/stack/pull/1674). * Some more changes for a better user experience. Please refer to the doc guide for details. * Add support for hpack, alternative package description format [#1679](https://github.com/commercialhaskell/stack/issues/1679) Other enhancements: * Docker: pass ~/.ssh and SSH auth socket into container, so that git repos work [#1358](https://github.com/commercialhaskell/stack/issues/1358). * Docker: strip suffix from docker --version. [#1653](https://github.com/commercialhaskell/stack/issues/1653) * Docker: pass USER and PWD environment variables into container. * On each run, stack will test the stack root directory (~/.stack), and the project and package work directories (.stack-work) for whether they are owned by the current user and abort if they are not. This precaution can be disabled with the `--allow-different-user` flag or `allow-different-user` option in the global config (~/.stack/config.yaml). [#471](https://github.com/commercialhaskell/stack/issues/471) * Added `stack clean --full` option for full working dir cleanup. * YAML config: support Zip archives. * Redownload build plan if parsing fails [#1702](https://github.com/commercialhaskell/stack/issues/1702). * Give mustache templates access to a 'year' tag [#1716](https://github.com/commercialhaskell/stack/pull/1716). * Have "stack ghci" warn about module name aliasing. * Add "stack ghci --load-local-deps". * Build Setup.hs with -rtsopts [#1687](https://github.com/commercialhaskell/stack/issues/1687). * `stack init` accepts a list of directories. * Add flag infos to DependencyPlanFailures (for better error output in case of flags) [#713](https://github.com/commercialhaskell/stack/issues/713) * `stack new --bare` complains for overwrites, and add `--force` option [#1597](https://github.com/commercialhaskell/stack/issues/1597). Bug fixes: * Previously, `stack ghci` would fail with `cannot satisfy -package-id` when the implicit build step changes the package key of some dependency. * Fix: Building with ghcjs: "ghc-pkg: Prelude.chr: bad argument: 2980338" [#1665](https://github.com/commercialhaskell/stack/issues/1665). * Fix running test / bench with `--profile` / `--trace`. * Fix: build progress counter is no longer visible [#1685](https://github.com/commercialhaskell/stack/issues/1685). * Use "-RTS" w/ profiling to allow extra args [#1772](https://github.com/commercialhaskell/stack/issues/1772). * Fix withUnpackedTarball7z to find name of srcDir after unpacking (fixes `stack setup` fails for ghcjs project on windows) [#1774](https://github.com/commercialhaskell/stack/issues/1774). * Add space before auto-generated bench opts (makes profiling options work uniformly for applications and benchmark suites) [#1771](https://github.com/commercialhaskell/stack/issues/1771). * Don't try to find plugin if it resembles flag. * Setup.hs changes cause package dirtiness [#1711](https://github.com/commercialhaskell/stack/issues/1711). * Send "stack templates" output to stdout [#1792](https://github.com/commercialhaskell/stack/issues/1792). ## 1.0.2 Release notes: - Arch Linux: Stack has been adopted into the [official community repository](https://www.archlinux.org/packages/community/x86_64/stack/), so we will no longer be updating the AUR with new versions. See the [install/upgrade guide](http://docs.haskellstack.org/en/stable/install_and_upgrade/#arch-linux) for current download instructions. Major changes: - `stack init` and `solver` overhaul [#1583](https://github.com/commercialhaskell/stack/pull/1583) Other enhancements: - Disable locale/codepage hacks when GHC >=7.10.3 [#1552](https://github.com/commercialhaskell/stack/issues/1552) - Specify multiple images to build for `stack image container` [docs](http://docs.haskellstack.org/en/stable/yaml_configuration/#image) - Specify which executables to include in images for `stack image container` [docs](http://docs.haskellstack.org/en/stable/yaml_configuration/#image) - Docker: pass supplemantary groups and umask into container - If git fetch fails wipe the directory and try again from scratch [#1418](https://github.com/commercialhaskell/stack/issues/1418) - Warn if newly installed executables won't be available on the PATH [#1362](https://github.com/commercialhaskell/stack/issues/1362) - stack.yaml: for `stack image container`, specify multiple images to generate, and which executables should be added to those images - GHCI: add interactive Main selection [#1068](https://github.com/commercialhaskell/stack/issues/1068) - Care less about the particular name of a GHCJS sdist folder [#1622](https://github.com/commercialhaskell/stack/issues/1622) - Unified Enable/disable help messaging [#1613](https://github.com/commercialhaskell/stack/issues/1613) Bug fixes: - Don't share precompiled packages between GHC/platform variants and Docker [#1551](https://github.com/commercialhaskell/stack/issues/1551) - Properly redownload corrupted downloads with the correct file size. [Mailing list discussion](https://groups.google.com/d/msg/haskell-stack/iVGDG5OHYxs/FjUrR5JsDQAJ) - Gracefully handle invalid paths in error/warning messages [#1561](https://github.com/commercialhaskell/stack/issues/1561) - Nix: select the correct GHC version corresponding to the snapshot even when an abstract resolver is passed via `--resolver` on the command-line. [#1641](https://github.com/commercialhaskell/stack/issues/1641) - Fix: Stack does not allow using an external package from ghci [#1557](https://github.com/commercialhaskell/stack/issues/1557) - Disable ambiguous global '--resolver' option for 'stack init' [#1531](https://github.com/commercialhaskell/stack/issues/1531) - Obey `--no-nix` flag - Fix: GHCJS Execute.hs: Non-exhaustive patterns in lambda [#1591](https://github.com/commercialhaskell/stack/issues/1591) - Send file-watch and sticky logger messages to stderr [#1302](https://github.com/commercialhaskell/stack/issues/1302) [#1635](https://github.com/commercialhaskell/stack/issues/1635) - Use globaldb path for querying Cabal version [#1647](https://github.com/commercialhaskell/stack/issues/1647) ## 1.0.0 Release notes: * We're calling this version 1.0.0 in preparation for Stackage LTS 4. Note, however, that this does not mean the code's API will be stable as this is primarily an end-user tool. Enhancements: * Added flag `--profile` flag: passed with `stack build`, it will enable profiling, and for `--bench` and `--test` it will generate a profiling report by passing `+RTS -p` to the executable(s). Great for using like `stack build --bench --profile` (remember that enabling profile will slow down your benchmarks by >4x). Run `stack build --bench` again to disable the profiling and get proper speeds * Added flag `--trace` flag: just like `--profile`, it enables profiling, but instead of generating a report for `--bench` and `--test`, prints out a stack trace on exception. Great for using like `stack build --test --trace` * Nix: all options can be overriden on command line [#1483](https://github.com/commercialhaskell/stack/issues/1483) * Nix: build environments (shells) are now pure by default. * Make verbosity silent by default in script interpreter mode [#1472](https://github.com/commercialhaskell/stack/issues/1472) * Show a message when resetting git commit fails [#1453](https://github.com/commercialhaskell/stack/issues/1453) * Improve Unicode handling in project/package names [#1337](https://github.com/commercialhaskell/stack/issues/1337) * Fix ambiguity between a stack command and a filename to execute (prefer `stack` subcommands) [#1471](https://github.com/commercialhaskell/stack/issues/1471) * Support multi line interpreter directive comments [#1394](https://github.com/commercialhaskell/stack/issues/1394) * Handle space separated pids in ghc-pkg dump (for GHC HEAD) [#1509](https://github.com/commercialhaskell/stack/issues/1509) * Add ghci --no-package-hiding option [#1517](https://github.com/commercialhaskell/stack/issues/1517) * `stack new` can download templates from URL [#1466](https://github.com/commercialhaskell/stack/issues/1466) Bug fixes: * Nix: stack exec options are passed properly to the stack sub process [#1538](https://github.com/commercialhaskell/stack/issues/1538) * Nix: specifying a shell-file works in any current working directory [#1547](https://github.com/commercialhaskell/stack/issues/1547) * Nix: use `--resolver` argument * Docker: fix missing image message and '--docker-auto-pull' * No HTML escaping for "stack new" template params [#1475](https://github.com/commercialhaskell/stack/issues/1475) * Set permissions for generated .ghci script [#1480](https://github.com/commercialhaskell/stack/issues/1480) * Restrict commands allowed in interpreter mode [#1504](https://github.com/commercialhaskell/stack/issues/1504) * stack ghci doesn't see preprocessed files for executables [#1347](https://github.com/commercialhaskell/stack/issues/1347) * All test suites run even when only one is requested [#1550](https://github.com/commercialhaskell/stack/pull/1550) * Edge cases in broken templates give odd errors [#1535](https://github.com/commercialhaskell/stack/issues/1535) * Fix test coverage bug on windows ## 0.1.10.1 Bug fixes: * `stack image container` did not actually build an image [#1473](https://github.com/commercialhaskell/stack/issues/1473) ## 0.1.10.0 Release notes: * The Stack home page is now at [haskellstack.org](http://haskellstack.org), which shows the documentation rendered by readthedocs.org. Note: this has necessitated some changes to the links in the documentation's markdown source code, so please check the links on the website before submitting a PR to fix them. * The locations of the [Ubuntu](http://docs.haskellstack.org/en/stable/install_and_upgrade/#ubuntu) and [Debian](http://docs.haskellstack.org/en/stable/install_and_upgrade/#debian) package repositories have changed to have correct URL semantics according to Debian's guidelines [#1378](https://github.com/commercialhaskell/stack/issues/1378). The old locations will continue to work for some months, but we suggest that you adjust your `/etc/apt/sources.list.d/fpco.list` to the new location to avoid future disruption. * [openSUSE and SUSE Linux Enterprise](http://docs.haskellstack.org/en/stable/install_and_upgrade/#suse) packages are now available, thanks to [@mimi1vx](https://github.com/mimi1vx). Note: there will be some lag before these pick up new versions, as they are based on Stackage LTS. Major changes: * Support for building inside a Nix-shell providing system dependencies [#1285](https://github.com/commercialhaskell/stack/pull/1285) * Add optional GPG signing on `stack upload --sign` or with `stack sig sign ...` Other enhancements: * Print latest applicable version of packages on conflicts [#508](https://github.com/commercialhaskell/stack/issues/508) * Support for packages located in Mercurial repositories [#1397](https://github.com/commercialhaskell/stack/issues/1397) * Only run benchmarks specified as build targets [#1412](https://github.com/commercialhaskell/stack/issues/1412) * Support git-style executable fall-through (`stack something` executes `stack-something` if present) [#1433](https://github.com/commercialhaskell/stack/issues/1433) * GHCi now loads intermediate dependencies [#584](https://github.com/commercialhaskell/stack/issues/584) * `--work-dir` option for overriding `.stack-work` [#1178](https://github.com/commercialhaskell/stack/issues/1178) * Support `detailed-0.9` tests [#1429](https://github.com/commercialhaskell/stack/issues/1429) * Docker: improved POSIX signal proxying to containers [#547](https://github.com/commercialhaskell/stack/issues/547) Bug fixes: * Show absolute paths in error messages in multi-package builds [#1348](https://github.com/commercialhaskell/stack/issues/1348) * Docker-built binaries and libraries in different path [#911](https://github.com/commercialhaskell/stack/issues/911) [#1367](https://github.com/commercialhaskell/stack/issues/1367) * Docker: `--resolver` argument didn't effect selected image tag * GHCi: Spaces in filepaths caused module loading issues [#1401](https://github.com/commercialhaskell/stack/issues/1401) * GHCi: cpp-options in cabal files weren't used [#1419](https://github.com/commercialhaskell/stack/issues/1419) * Benchmarks couldn't be run independently of eachother [#1412](https://github.com/commercialhaskell/stack/issues/1412) * Send output of building setup to stderr [#1410](https://github.com/commercialhaskell/stack/issues/1410) ## 0.1.8.0 Major changes: * GHCJS can now be used with stackage snapshots via the new `compiler` field. * Windows installers are now available: [download them here](http://docs.haskellstack.org/en/stable/install_and_upgrade/#windows) [#613](https://github.com/commercialhaskell/stack/issues/613) * Docker integration works with non-FPComplete generated images [#531](https://github.com/commercialhaskell/stack/issues/531) Other enhancements: * Added an `allow-newer` config option [#922](https://github.com/commercialhaskell/stack/issues/922) [#770](https://github.com/commercialhaskell/stack/issues/770) * When a Hackage revision invalidates a build plan in a snapshot, trust the snapshot [#770](https://github.com/commercialhaskell/stack/issues/770) * Added a `stack config set resolver RESOLVER` command. Part of work on [#115](https://github.com/commercialhaskell/stack/issues/115) * `stack setup` can now install GHCJS on windows. See [#1145](https://github.com/commercialhaskell/stack/issues/1145) and [#749](https://github.com/commercialhaskell/stack/issues/749) * `stack hpc report` command added, which generates reports for HPC tix files * `stack ghci` now accepts all the flags accepted by `stack build`. See [#1186](https://github.com/commercialhaskell/stack/issues/1186) * `stack ghci` builds the project before launching GHCi. If the build fails, optimistically launch GHCi anyway. Use `stack ghci --no-build` option to disable [#1065](https://github.com/commercialhaskell/stack/issues/1065) * `stack ghci` now detects and warns about various circumstances where it is liable to fail. See [#1270](https://github.com/commercialhaskell/stack/issues/1270) * Added `require-docker-version` configuration option * Packages will now usually be built along with their tests and benchmarks. See [#1166](https://github.com/commercialhaskell/stack/issues/1166) * Relative `local-bin-path` paths will be relative to the project's root directory, not the current working directory. [#1340](https://github.com/commercialhaskell/stack/issues/1340) * `stack clean` now takes an optional `[PACKAGE]` argument for use in multi-package projects. See [#583](https://github.com/commercialhaskell/stack/issues/583) * Ignore cabal_macros.h as a dependency [#1195](https://github.com/commercialhaskell/stack/issues/1195) * Pad timestamps and show local time in --verbose output [#1226](https://github.com/commercialhaskell/stack/issues/1226) * GHCi: Import all modules after loading them [#995](https://github.com/commercialhaskell/stack/issues/995) * Add subcommand aliases: `repl` for `ghci`, and `runhaskell` for `runghc` [#1241](https://github.com/commercialhaskell/stack/issues/1241) * Add typo recommendations for unknown package identifiers [#158](https://github.com/commercialhaskell/stack/issues/158) * Add `stack path --local-hpc-root` option * Overhaul dependencies' haddocks copying [#1231](https://github.com/commercialhaskell/stack/issues/1231) * Support for extra-package-dbs in 'stack ghci' [#1229](https://github.com/commercialhaskell/stack/pull/1229) * `stack new` disallows package names with "words" consisting solely of numbers [#1336](https://github.com/commercialhaskell/stack/issues/1336) * `stack build --fast` turns off optimizations * Show progress while downloading package index [#1223](https://github.com/commercialhaskell/stack/issues/1223). Bug fixes: * Fix: Haddocks not copied for dependencies [#1105](https://github.com/commercialhaskell/stack/issues/1105) * Fix: Global options did not work consistently after subcommand [#519](https://github.com/commercialhaskell/stack/issues/519) * Fix: 'stack ghci' doesn't notice that a module got deleted [#1180](https://github.com/commercialhaskell/stack/issues/1180) * Rebuild when cabal file is changed * Fix: Paths in GHC warnings not canonicalized, nor those for packages in subdirectories or outside the project root [#1259](https://github.com/commercialhaskell/stack/issues/1259) * Fix: unlisted files in tests and benchmarks trigger extraneous second build [#838](https://github.com/commercialhaskell/stack/issues/838) ## 0.1.6.0 Major changes: * `stack setup` now supports building and booting GHCJS from source tarball. * On Windows, build directories no longer display "pretty" information (like x86_64-windows/Cabal-1.22.4.0), but rather a hash of that content. The reason is to avoid the 260 character path limitation on Windows. See [#1027](https://github.com/commercialhaskell/stack/pull/1027) * Rename config files and clarify their purposes [#969](https://github.com/commercialhaskell/stack/issues/969) * `~/.stack/stack.yaml` --> `~/.stack/config.yaml` * `~/.stack/global` --> `~/.stack/global-project` * `/etc/stack/config` --> `/etc/stack/config.yaml` * Old locations still supported, with deprecation warnings * New command "stack eval CODE", which evaluates to "stack exec ghc -- -e CODE". Other enhancements: * No longer install `git` on Windows [#1046](https://github.com/commercialhaskell/stack/issues/1046). You can still get this behavior by running the following yourself: `stack exec -- pacman -Sy --noconfirm git`. * Typing enter during --file-watch triggers a rebuild [#1023](https://github.com/commercialhaskell/stack/pull/1023) * Use Haddock's `--hyperlinked-source` (crosslinked source), if available [#1070](https://github.com/commercialhaskell/stack/pull/1070) * Use Stack-installed GHCs for `stack init --solver` [#1072](https://github.com/commercialhaskell/stack/issues/1072) * New experimental `stack query` command [#1087](https://github.com/commercialhaskell/stack/issues/1087) * By default, stack no longer rebuilds a package due to GHC options changes. This behavior can be tweaked with the `rebuild-ghc-options` setting. [#1089](https://github.com/commercialhaskell/stack/issues/1089) * By default, ghc-options are applied to all local packages, not just targets. This behavior can be tweaked with the `apply-ghc-options` setting. [#1089](https://github.com/commercialhaskell/stack/issues/1089) * Docker: download or override location of stack executable to re-run in container [#974](https://github.com/commercialhaskell/stack/issues/974) * Docker: when Docker Engine is remote, don't run containerized processes as host's UID/GID [#194](https://github.com/commercialhaskell/stack/issues/194) * Docker: `set-user` option to enable/disable running containerized processes as host's UID/GID [#194](https://github.com/commercialhaskell/stack/issues/194) * Custom Setup.hs files are now precompiled instead of interpreted. This should be a major performance win for certain edge cases (biggest example: [building Cabal itself](https://github.com/commercialhaskell/stack/issues/1041)) while being either neutral or a minor slowdown for more common cases. * `stack test --coverage` now also generates a unified coverage report for multiple test-suites / packages. In the unified report, test-suites can contribute to the coverage of other packages. Bug fixes: * Ignore stack-built executables named `ghc` [#1052](https://github.com/commercialhaskell/stack/issues/1052) * Fix quoting of output failed command line arguments * Mark executable-only packages as installed when copied from cache [#1043](https://github.com/commercialhaskell/stack/pull/1043) * Canonicalize temporary directory paths [#1047](https://github.com/commercialhaskell/stack/pull/1047) * Put code page fix inside the build function itself [#1066](https://github.com/commercialhaskell/stack/issues/1066) * Add `explicit-setup-deps` option [#1110](https://github.com/commercialhaskell/stack/issues/1110), and change the default to the old behavior of using any package in the global and snapshot database [#1025](https://github.com/commercialhaskell/stack/issues/1025) * Precompiled cache checks full package IDs on Cabal < 1.22 [#1103](https://github.com/commercialhaskell/stack/issues/1103) * Pass -package-id to ghci [#867](https://github.com/commercialhaskell/stack/issues/867) * Ignore global packages when copying precompiled packages [#1146](https://github.com/commercialhaskell/stack/issues/1146) ## 0.1.5.0 Major changes: * On Windows, we now use a full MSYS2 installation in place of the previous PortableGit. This gives you access to the pacman package manager for more easily installing libraries. * Support for custom GHC binary distributions [#530](https://github.com/commercialhaskell/stack/issues/530) * `ghc-variant` option in stack.yaml to specify the variant (also `--ghc-variant` command-line option) * `setup-info` in stack.yaml, to specify where to download custom binary distributions (also `--ghc-bindist` command-line option) * Note: On systems with libgmp4 (aka `libgmp.so.3`), such as CentOS 6, you may need to re-run `stack setup` due to the centos6 GHC bindist being treated like a variant * A new `--pvp-bounds` flag to the sdist and upload commands allows automatic adding of PVP upper and/or lower bounds to your dependencies Other enhancements: * Adapt to upcoming Cabal installed package identifier format change [#851](https://github.com/commercialhaskell/stack/issues/851) * `stack setup` takes a `--stack-setup-yaml` argument * `--file-watch` is more discerning about which files to rebuild for [#912](https://github.com/commercialhaskell/stack/issues/912) * `stack path` now supports `--global-pkg-db` and `--ghc-package-path` * `--reconfigure` flag [#914](https://github.com/commercialhaskell/stack/issues/914) [#946](https://github.com/commercialhaskell/stack/issues/946) * Cached data is written with a checksum of its structure [#889](https://github.com/commercialhaskell/stack/issues/889) * Fully removed `--optimizations` flag * Added `--cabal-verbose` flag * Added `--file-watch-poll` flag for polling instead of using filesystem events (useful for running tests in a Docker container while modifying code in the host environment. When code is injected into the container via a volume, the container won't propagate filesystem events). * Give a preemptive error message when `-prof` is given as a GHC option [#1015](https://github.com/commercialhaskell/stack/issues/1015) * Locking is now optional, and will be turned on by setting the `STACK_LOCK` environment variable to `true` [#950](https://github.com/commercialhaskell/stack/issues/950) * Create default stack.yaml with documentation comments and commented out options [#226](https://github.com/commercialhaskell/stack/issues/226) * Out of memory warning if Cabal exits with -9 [#947](https://github.com/commercialhaskell/stack/issues/947) Bug fixes: * Hacky workaround for optparse-applicative issue with `stack exec --help` [#806](https://github.com/commercialhaskell/stack/issues/806) * Build executables for local extra deps [#920](https://github.com/commercialhaskell/stack/issues/920) * copyFile can't handle directories [#942](https://github.com/commercialhaskell/stack/pull/942) * Support for spaces in Haddock interface files [fpco/minghc#85](https://github.com/fpco/minghc/issues/85) * Temporarily building against a "shadowing" local package? [#992](https://github.com/commercialhaskell/stack/issues/992) * Fix Setup.exe name for --upgrade-cabal on Windows [#1002](https://github.com/commercialhaskell/stack/issues/1002) * Unlisted dependencies no longer trigger extraneous second build [#838](https://github.com/commercialhaskell/stack/issues/838) ## 0.1.4.1 Fix stack's own Haddocks. No changes to functionality (only comments updated). ## 0.1.4.0 Major changes: * You now have more control over how GHC versions are matched, e.g. "use exactly this version," "use the specified minor version, but allow patches," or "use the given minor version or any later minor in the given major release." The default has switched from allowing newer later minor versions to a specific minor version allowing patches. For more information, see [#736](https://github.com/commercialhaskell/stack/issues/736) and [#784](https://github.com/commercialhaskell/stack/pull/784). * Support added for compiling with GHCJS * stack can now reuse prebuilt binaries between snapshots. That means that, if you build package foo in LTS-3.1, that binary version can be reused in LTS-3.2, assuming it uses the same dependencies and flags. [#878](https://github.com/commercialhaskell/stack/issues/878) Other enhancements: * Added the `--docker-env` argument, to set environment variables in Docker container. * Set locale environment variables to UTF-8 encoding for builds to avoid "commitBuffer: invalid argument" errors from GHC [#793](https://github.com/commercialhaskell/stack/issues/793) * Enable translitation for encoding on stdout and stderr [#824](https://github.com/commercialhaskell/stack/issues/824) * By default, `stack upgrade` automatically installs GHC as necessary [#797](https://github.com/commercialhaskell/stack/issues/797) * Added the `ghc-options` field to stack.yaml [#796](https://github.com/commercialhaskell/stack/issues/796) * Added the `extra-path` field to stack.yaml * Code page changes on Windows only apply to the build command (and its synonyms), and can be controlled via a command line flag (still defaults to on) [#757](https://github.com/commercialhaskell/stack/issues/757) * Implicitly add packages to extra-deps when a flag for them is set [#807](https://github.com/commercialhaskell/stack/issues/807) * Use a precompiled Setup.hs for simple build types [#801](https://github.com/commercialhaskell/stack/issues/801) * Set --enable-tests and --enable-benchmarks optimistically [#805](https://github.com/commercialhaskell/stack/issues/805) * `--only-configure` option added [#820](https://github.com/commercialhaskell/stack/issues/820) * Check for duplicate local package names * Stop nagging people that call `stack test` [#845](https://github.com/commercialhaskell/stack/issues/845) * `--file-watch` will ignore files that are in your VCS boring/ignore files [#703](https://github.com/commercialhaskell/stack/issues/703) * Add `--numeric-version` option Bug fixes: * `stack init --solver` fails if `GHC_PACKAGE_PATH` is present [#860](https://github.com/commercialhaskell/stack/issues/860) * `stack solver` and `stack init --solver` check for test suite and benchmark dependencies [#862](https://github.com/commercialhaskell/stack/issues/862) * More intelligent logic for setting UTF-8 locale environment variables [#856](https://github.com/commercialhaskell/stack/issues/856) * Create missing directories for `stack sdist` * Don't ignore .cabal files with extra periods [#895](https://github.com/commercialhaskell/stack/issues/895) * Deprecate unused `--optimizations` flag * Truncated output on slow terminals [#413](https://github.com/commercialhaskell/stack/issues/413) ## 0.1.3.1 Bug fixes: * Ignore disabled executables [#763](https://github.com/commercialhaskell/stack/issues/763) ## 0.1.3.0 Major changes: * Detect when a module is compiled but not listed in the cabal file ([#32](https://github.com/commercialhaskell/stack/issues/32)) * A warning is displayed for any modules that should be added to `other-modules` in the .cabal file * These modules are taken into account when determining whether a package needs to be built * Respect TemplateHaskell addDependentFile dependency changes ([#105](https://github.com/commercialhaskell/stack/issues/105)) * TH dependent files are taken into account when determining whether a package needs to be built. * Overhauled target parsing, added `--test` and `--bench` options [#651](https://github.com/commercialhaskell/stack/issues/651) * For details, see [Build commands documentation](http://docs.haskellstack.org/en/stable/build_command/) Other enhancements: * Set the `HASKELL_DIST_DIR` environment variable [#524](https://github.com/commercialhaskell/stack/pull/524) * Track build status of tests and benchmarks [#525](https://github.com/commercialhaskell/stack/issues/525) * `--no-run-tests` [#517](https://github.com/commercialhaskell/stack/pull/517) * Targets outside of root dir don't build [#366](https://github.com/commercialhaskell/stack/issues/366) * Upper limit on number of flag combinations to test [#543](https://github.com/commercialhaskell/stack/issues/543) * Fuzzy matching support to give better error messages for close version numbers [#504](https://github.com/commercialhaskell/stack/issues/504) * `--local-bin-path` global option. Use to change where binaries get placed on a `--copy-bins` [#342](https://github.com/commercialhaskell/stack/issues/342) * Custom snapshots [#111](https://github.com/commercialhaskell/stack/issues/111) * --force-dirty flag: Force treating all local packages as having dirty files (useful for cases where stack can't detect a file change) * GHC error messages: display file paths as absolute instead of relative for better editor integration * Add the `--copy-bins` option [#569](https://github.com/commercialhaskell/stack/issues/569) * Give warnings on unexpected config keys [#48](https://github.com/commercialhaskell/stack/issues/48) * Remove Docker `pass-host` option * Don't require cabal-install to upload [#313](https://github.com/commercialhaskell/stack/issues/313) * Generate indexes for all deps and all installed snapshot packages [#143](https://github.com/commercialhaskell/stack/issues/143) * Provide `--resolver global` option [#645](https://github.com/commercialhaskell/stack/issues/645) * Also supports `--resolver nightly`, `--resolver lts`, and `--resolver lts-X` * Make `stack build --flag` error when flag or package is unknown [#617](https://github.com/commercialhaskell/stack/issues/617) * Preserve file permissions when unpacking sources [#666](https://github.com/commercialhaskell/stack/pull/666) * `stack build` etc work outside of a project * `list-dependencies` command [#638](https://github.com/commercialhaskell/stack/issues/638) * `--upgrade-cabal` option to `stack setup` [#174](https://github.com/commercialhaskell/stack/issues/174) * `--exec` option [#651](https://github.com/commercialhaskell/stack/issues/651) * `--only-dependencies` implemented correctly [#387](https://github.com/commercialhaskell/stack/issues/387) Bug fixes: * Extensions from the `other-extensions` field no longer enabled by default [#449](https://github.com/commercialhaskell/stack/issues/449) * Fix: haddock forces rebuild of empty packages [#452](https://github.com/commercialhaskell/stack/issues/452) * Don't copy over executables excluded by component selection [#605](https://github.com/commercialhaskell/stack/issues/605) * Fix: stack fails on Windows with git package in stack.yaml and no git binary on path [#712](https://github.com/commercialhaskell/stack/issues/712) * Fixed GHCi issue: Specifying explicit package versions (#678) * Fixed GHCi issue: Specifying -odir and -hidir as .stack-work/odir (#529) * Fixed GHCi issue: Specifying A instead of A.ext for modules (#498) ## 0.1.2.0 * Add `--prune` flag to `stack dot` [#487](https://github.com/commercialhaskell/stack/issues/487) * Add `--[no-]external`,`--[no-]include-base` flags to `stack dot` [#437](https://github.com/commercialhaskell/stack/issues/437) * Add `--ignore-subdirs` flag to init command [#435](https://github.com/commercialhaskell/stack/pull/435) * Handle attempt to use non-existing resolver [#436](https://github.com/commercialhaskell/stack/pull/436) * Add `--force` flag to `init` command * exec style commands accept the `--package` option (see [Reddit discussion](http://www.reddit.com/r/haskell/comments/3bd66h/stack_runghc_turtle_as_haskell_script_solution/)) * `stack upload` without arguments doesn't do anything [#439](https://github.com/commercialhaskell/stack/issues/439) * Print latest version of packages on conflicts [#450](https://github.com/commercialhaskell/stack/issues/450) * Flag to avoid rerunning tests that haven't changed [#451](https://github.com/commercialhaskell/stack/issues/451) * stack can act as a script interpreter (see [Script interpreter] (https://github.com/commercialhaskell/stack/wiki/Script-interpreter) and [Reddit discussion](http://www.reddit.com/r/haskell/comments/3bd66h/stack_runghc_turtle_as_haskell_script_solution/)) * Add the __`--file-watch`__ flag to auto-rebuild on file changes [#113](https://github.com/commercialhaskell/stack/issues/113) * Rename `stack docker exec` to `stack exec --plain` * Add the `--skip-msys` flag [#377](https://github.com/commercialhaskell/stack/issues/377) * `--keep-going`, turned on by default for tests and benchmarks [#478](https://github.com/commercialhaskell/stack/issues/478) * `concurrent-tests: BOOL` [#492](https://github.com/commercialhaskell/stack/issues/492) * Use hashes to check file dirtiness [#502](https://github.com/commercialhaskell/stack/issues/502) * Install correct GHC build on systems with libgmp.so.3 [#465](https://github.com/commercialhaskell/stack/issues/465) * `stack upgrade` checks version before upgrading [#447](https://github.com/commercialhaskell/stack/issues/447) ## 0.1.1.0 * Remove GHC uncompressed tar file after installation [#376](https://github.com/commercialhaskell/stack/issues/376) * Put stackage snapshots JSON on S3 [#380](https://github.com/commercialhaskell/stack/issues/380) * Specifying flags for multiple packages [#335](https://github.com/commercialhaskell/stack/issues/335) * single test suite failure should show entire log [#388](https://github.com/commercialhaskell/stack/issues/388) * valid-wanted is a confusing option name [#386](https://github.com/commercialhaskell/stack/issues/386) * stack init in multi-package project should use local packages for dependency checking [#384](https://github.com/commercialhaskell/stack/issues/384) * Display information on why a snapshot was rejected [#381](https://github.com/commercialhaskell/stack/issues/381) * Give a reason for unregistering packages [#389](https://github.com/commercialhaskell/stack/issues/389) * `stack exec` accepts the `--no-ghc-package-path` parameter * Don't require build plan to upload [#400](https://github.com/commercialhaskell/stack/issues/400) * Specifying test components only builds/runs those tests [#398](https://github.com/commercialhaskell/stack/issues/398) * `STACK_EXE` environment variable * Add the `stack dot` command * `stack upgrade` added [#237](https://github.com/commercialhaskell/stack/issues/237) * `--stack-yaml` command line flag [#378](https://github.com/commercialhaskell/stack/issues/378) * `--skip-ghc-check` command line flag [#423](https://github.com/commercialhaskell/stack/issues/423) Bug fixes: * Haddock links to global packages no longer broken on Windows [#375](https://github.com/commercialhaskell/stack/issues/375) * Make flags case-insensitive [#397](https://github.com/commercialhaskell/stack/issues/397) * Mark packages uninstalled before rebuilding [#365](https://github.com/commercialhaskell/stack/issues/365) ## 0.1.0.0 * Fall back to cabal dependency solver when a snapshot can't be found * Basic implementation of `stack new` [#137](https://github.com/commercialhaskell/stack/issues/137) * `stack solver` command [#364](https://github.com/commercialhaskell/stack/issues/364) * `stack path` command [#95](https://github.com/commercialhaskell/stack/issues/95) * Haddocks [#143](https://github.com/commercialhaskell/stack/issues/143): * Build for dependencies * Use relative links * Generate module contents and index for all packages in project ## 0.0.3 * `--prefetch` [#297](https://github.com/commercialhaskell/stack/issues/297) * `upload` command ported from stackage-upload [#225](https://github.com/commercialhaskell/stack/issues/225) * `--only-snapshot` [#310](https://github.com/commercialhaskell/stack/issues/310) * `--resolver` [#224](https://github.com/commercialhaskell/stack/issues/224) * `stack init` [#253](https://github.com/commercialhaskell/stack/issues/253) * `--extra-include-dirs` and `--extra-lib-dirs` [#333](https://github.com/commercialhaskell/stack/issues/333) * Specify intra-package target [#201](https://github.com/commercialhaskell/stack/issues/201) ## 0.0.2 * Fix some Windows specific bugs [#216](https://github.com/commercialhaskell/stack/issues/216) * Improve output for package index updates [#227](https://github.com/commercialhaskell/stack/issues/227) * Automatically update indices as necessary [#227](https://github.com/commercialhaskell/stack/issues/227) * --verbose flag [#217](https://github.com/commercialhaskell/stack/issues/217) * Remove packages (HTTPS and Git) [#199](https://github.com/commercialhaskell/stack/issues/199) * Config values for system-ghc and install-ghc * Merge `stack deps` functionality into `stack build` * `install` command [#153](https://github.com/commercialhaskell/stack/issues/153) and [#272](https://github.com/commercialhaskell/stack/issues/272) * overriding architecture value (useful to force 64-bit GHC on Windows, for example) * Overhauled test running (allows cycles, avoids unnecessary recompilation, etc) ## 0.0.1 * First public release, beta quality stack-1.1.2/README.md0000644000000000000000000000121512711161622012263 0ustar0000000000000000## The Haskell Tool Stack [![Build Status](https://travis-ci.org/commercialhaskell/stack.svg?branch=master)](https://travis-ci.org/commercialhaskell/stack) [![Windows build status](https://ci.appveyor.com/api/projects/status/c1c7uvmw6x1dupcl?svg=true)](https://ci.appveyor.com/project/snoyberg/stack) [![Release](https://img.shields.io/github/release/commercialhaskell/stack.svg)](https://github.com/commercialhaskell/stack/releases) Stack is a cross-platform program for developing Haskell projects. It is intended for Haskellers both new and experienced. See [haskellstack.org](http://haskellstack.org) or the `doc` directory for more information. stack-1.1.2/doc/architecture.md0000644000000000000000000002114712630674604014574 0ustar0000000000000000# Architecture ## Terminology * Package identifier: a package name and version, e.g. text-1.2.1.0 * GhcPkgId: a package identifier plus the unique hash for the generated binary, e.g. text-1.2.1.0-bb83023b42179dd898ebe815ada112c2 * Package index: a collection of packages available for download. This is a combination of an index containing all of the .cabal files (either a tarball downloaded via HTTP(S) or a Git repository) and some way to download package tarballs. * By default, stack uses a single package index (the Github/S3 mirrors of Hackage), but supports customization and adding more than one index * Package database: a collection of metadata about built libraries * Install root: a destination for installing packages into. Contains a bin path (for generated executables), lib (for the compiled libraries), pkgdb (for the package database), and a few other things * Snapshot: an LTS Haskell or Stackage Nightly, which gives information on a complete set of packages. This contains a lot of metadata, but importantly it can be converted into a mini build plan... * Mini build plan: a collection of package identifiers and their build flags that are known to build together * Resolver: the means by which stack resolves dependencies for your packages. The two currently supported options are snapshot (using LTS or Nightly), and GHC (which installs no extra dependencies). Others may be added in the future (such as a SAT-based dependency solver). These packages are always taken from a package index * extra-deps: additional packages to be taken from the package index for dependencies. This list will *shadow* packages provided by the resolver * Local packages: source code actually present on your file system, and referred to by the `packages` field in your stack.yaml file. Each local package has exactly one .cabal file * Project: a stack.yaml config file and all of the local packages it refers to. ## Databases Every build uses three distinct install roots, which means three separate package databases and bin paths. These are: * Global: the packages that ship with GHC. We never install anything into this database * Snapshot: a database shared by all projects using the same snapshot. Packages installed in this database must use the exact same dependencies and build flags as specified in the snapshot, and cannot be affected by user flags, ensuring that one project cannot corrupt another. There are two caveats to this: * If different projects use different package indices, then their definitions of what package foo-1.2.3 are may be different, in which case they *can* corrupt each other's shared databases. This is warned about in the FAQ * Turning on profiling may cause a package to be recompiled, which will result in a different GhcPkgId * Local: extra-deps, local packages, and snapshot packages which depend on them (more on that in shadowing) ## Building ### Shadowing Every project must have precisely one version of a package. If one of your local packages or extra dependencies conflicts with a package in the snapshot, the local/extradep *shadows* the snapshot version. The way this works is: * The package is removed from the list of packages in the snapshot * Any package that depends on that package (directly or indirectly) is moved from the snapshot to extra-deps, so that it is available to your packages as dependencies. * Note that there is no longer any guarantee that this package will build, since you're using an untested dependency After shadowing, you end up with what is called internally a `SourceMap`, which is `Map PackageName PackageSource`, where a `PackageSource` can be either a local package, or a package taken from a package index (specified as a version number and the build flags). ### Installed packages Once you have a `SourceMap`, you can inspect your three available databases and decide which of the installed packages you wish to use from them. We move from the global, to snapshot, and finally local, with the following rules: * If we require profiling, and the library does not provide profiling, do not use it * If the package is in the `SourceMap`, but belongs to a difference database, or has a different version, do not use it * If after the above two steps, any of the dependencies are unavailable, do not use it * Otherwise: include the package in the list of installed packages We do something similar for executables, but maintain our own database of installed executables, since GHC does not track them for us. ### Plan construction When running a build, we know which packages we want installed (inventively called "wanteds"), which packages are available to install, and which are already installed. In plan construction, we put them information together to decide which packages must be built. The code in Stack.Build.ConstructPlan is authoritative on this and should be consulted. The basic idea though is: * If any of the dependencies have changed, reconfigure and rebuild * If a local package has any files changed, rebuild (but don't bother reconfiguring) * If a local package is wanted and we're running tests or benchmarks, run the test or benchmark even if the code and dependencies haven't changed ### Plan execution Once we have the plan, execution is a relatively simple process of calling `runghc Setup.hs` in the correct order with the correct parameters. See Stack.Build.Execute for more information. ## Configuration stack has two layers of configuration: project and non-project. All of these are stored in stack.yaml files, but the former has extra fields (resolver, packages, extra-deps, and flags). The latter can be monoidally combined so that a system config file provides defaults, which a user can override with `~/.stack/config.yaml`, and a project can further customize. In addition, environment variables STACK\_ROOT and STACK\_YAML can be used to tweak where stack gets its configuration from. stack follows a simple algorithm for finding your project configuration file: start in the current directory, and keep going to the parent until it finds a `stack.yaml`. When using `stack ghc` or `stack exec` as mentioned above, you'll sometimes want to override that behavior and point to a specific project in order to use its databases and bin directories. To do so, simply set the `STACK_YAML` environment variable to point to the relevant `stack.yaml` file. ## Snapshot auto-detection When you run `stack build` with no stack.yaml, it will create a basic configuration with a single package (the current directory) and an auto-detected snapshot. The algorithm it uses for selecting this snapshot is: * Try the latest two LTS major versions at their most recent minor version release, and the most recent Stackage Nightly. For example, at the time of writing, this would be lts-2.10, lts-1.15, and nightly-2015-05-26 * For each of these, test the version bounds in the package's .cabal file to see if they are compatible with the snapshot, choosing the first one that matches * If no snapshot matches, uses the most recent LTS snapshot, even though it will not compile If you end up in the no compatible snapshot case, you typically have three options to fix things: * Manually specify a different snapshot that you know to be compatible. If you can do that, great, but typically if the auto-detection fails, it means that there's no compatible snapshot * Modify version bounds in your .cabal file to be compatible with the selected snapshot * Add `extra-deps` to your stack.yaml file to fix compatibility problems Remember that running `stack build` will give you information on why your build cannot occur, which should help guide you through the steps necessary for the second and third option above. Also, note that those options can be mixed-and-matched, e.g. you may decide to relax some version bounds in your .cabal file, while also adding some extra-deps. ## Explicit breakage As mentioned above, updating your package indices will not cause stack to invalidate any existing package databases. That's because stack is always explicit about build plans, via: 1. the selected snapshot 2. the extra-deps 3. local packages The only way to change a plan for packages to be installed is by modifying one of the above. This means that breakage of a set of installed packages is an *explicit* and *contained* activity. Specifically, you get the following guarantees: * Since snapshots are immutable, the snapshot package database will not be invalidated by any action. If you change the snapshot you're using, however, you may need to build those packages from scratch. * If you modify your extra-deps, stack may need to unregister and reinstall them. * Any changes to your local packages trigger a rebuild of that package and its dependencies. stack-1.1.2/doc/build_command.md0000644000000000000000000001601712630674604014707 0ustar0000000000000000# Build command ## Overview The primary command you use in stack is build. This page describes the details of build's command line interface. The goal of the interface is to do the right thing for simple input, and allow a lot of flexibility for more complicated goals. ## Synonyms One potential point of confusion is the synonym commands for `build`. These are provided to match commonly expected command line interfaces, and to make common workflows shorter. The important thing to note is that all of these are just the `build` command in disguise. Each of these commands are called out as synonyms in the `--help` output. These commands are: * `stack test` is the same as `stack build --test` * `stack bench` is the same as `stack build --bench` * `stack haddock` is the same as `stack build --haddock` * `stack install` is the same as `stack build --copy-bins` The advantage of the synonym commands is that they're convenient and short. The advantage of the options is that they compose. For example, `stack build --test --copy-bins` will build libraries, executables, and test suites, run the test suites, and then copy the executables to your local bin path (more on this below). ## Components Components are a subtle yet important point to how build operates under the surface. Every cabal package is made up of one or more components. It can have 0 or 1 libraries, and then 0 or more of executable, test, and benchmark components. stack allows you to call out a specific component to be built, e.g. `stack build mypackage:test:mytests` will build the `mytests` component of the `mypackage` package. `mytests` must be a test suite component. We'll get into the details of the target syntax for how to select components in the next section. In this section, the important point is: whenever you target a test suite or a benchmark, it's built __and also run__, unless you explicitly disable running via `--no-run-tests` or `--no-run-benchmarks`. Case in point: the previous command will in fact build the `mytests` test suite *and* run it, even though you haven't used the `stack test` command or the `--test` option. (We'll get to what exactly `--test` does below.) This gives you a lot of flexibility in choosing what you want stack to do. You can run a single test component from a package, run a test component from one package and a benchmark from another package, etc. One final note on components: you can only control components for local packages, not dependencies. With dependencies, stack will *always* build the library (if present) and all executables, and ignore test suites and benchmarks. If you want more control over a package, you must add it to your `packages` setting in your stack.yaml file. ## Target syntax In addition to a number of options (like the aforementioned `--test`), `stack build` takes a list of zero or more *targets* to be built. There are a number of different syntaxes supported for this list: * *package*, e.g. `stack build foobar`, is the most commonly used target. It will try to find the package in the following locations: local packages, extra dependencies, snapshots, and package index (e.g. Hackage). If it's found in the package index, then the latest version of that package from the index is implicitly added to your extra dependencies. This is where the `--test` and `--bench` flags come into play. If the package is a local package, then all of the test suite and benchmark components are selected to be built, respectively. In any event, the library and executable components are also selected to be built. * *package identifier*, e.g. `stack build foobar-1.2.3`, is usually used to include specific package versions from the index. If the version selected conflicts with an existing local package or extra dep, then stack fails with an error. Otherwise, this is the same as calling `stack build foobar`, except instead of using the latest version from the index, the version specified is used. * *component*. Instead of referring to an entire package and letting stack decide which components to build, you select individual components from inside a package. This can be done for more fine-grained control over which test suites to run, or to have a faster compilation cycle. There are multiple ways to refer to a specific component (provided for convenience): * `packagename:comptype:compname` is the most explicit. The available comptypes are `exe`, `test`, and `bench`. * `packagename:compname` allows you to leave off the component type, as that will (almost?) always be redundant with the component name. For example, `stack build mypackage:mytestsuite`. * `:compname` is a useful shortcut, saying "find the component in all of the local packages." This will result in an error if multiple packages have a component with the same name. To continue the above example, `stack build :mytestsuite`. * Side note: the commonly requested `run` command is not available because it's a simple combination of `stack build :exename && stack exec exename` * *directory*, e.g. `stack build foo/bar`, will find all local packages that exist in the given directory hierarchy and then follow the same procedure as passing in package names as mentioned above. There's an important caveat here: if your directory name is parsed as one of the above target types, it will be treated as that. Explicitly starting your target with `./` can be a good way to avoid that, e.g. `stack build ./foo` Finally: if you provide no targets (e.g., running `stack build`), stack will implicitly pass in all of your local packages. If you only want to target packages in the current directory or deeper, you can pass in `.`, e.g. `stack build .`. ### Examples FIXME: what examples would be helpful? Need feedback on what's confusing above ## Dependencies stack will always automatically build all dependencies necessary for its targets. ## Other flags There are a number of other flags accepted by `stack build`. Instead of listing all of them, please use `stack build --help`. Some particularly convenient ones worth mentioning here since they compose well with the rest of the build system as described: * `--file-watch` will rebuild your project every time a file changes * `--exec "cmd [args]"` will run a command after a successful build To come back to the composable approach described above, consider this final example (which uses the [wai repository](https://github.com/yesodweb/wai/): ``` stack build --file-watch --test --copy-bins --haddock wai-extra :warp warp:doctest --exec 'echo Yay, it worked!' ``` This command will: * Start stack up in file watch mode, waiting for files in your project to change. When first starting, and each time a file changes, it will do all of the following. * Build the wai-extra package and its test suites * Build the `warp` executable * Build the warp package's doctest component (which, as you may guess, is a test site) * Run all of the wai-extra package's test suite components and the doctest test suite component * If all of that succeeds: * Copy generated executables to the local bin path * Run the command `echo Yay, it worked!` stack-1.1.2/doc/ChangeLog.md0000644000000000000000000014007212717707440013741 0ustar0000000000000000# Changelog ## 1.1.2 Release notes: * Official FreeBSD binaries are [now available](http://docs.haskellstack.org/en/stable/install_and_upgrade/#freebsd) [#1253](https://github.com/commercialhaskell/stack/issues/1253). Major changes: * Extensible custom snapshots implemented. These allow you to define snapshots which extend other snapshots. See [#863](https://github.com/commercialhaskell/stack/issues/863). Local file custom snapshots can now be safely updated without changing their name. Remote custom snapshots should still be treated as immutable. Behavior changes: * `stack path --compiler` was added in the last release, to yield a path to the compiler. Unfortunately, `--compiler` is a global option that is useful to use with `stack path`. The same functionality is now provided by `stack path --compiler-exe`. See [#2123](https://github.com/commercialhaskell/stack/issues/2123) * For packages specified in terms of a git or hg repo, the hash used in the location has changed. This means that existing downloads from older stack versions won't be used. This is a side-effect of the fix to [#2133](https://github.com/commercialhaskell/stack/issues/2133) * `stack upgrade` no longer pays attention to local stack.yaml files, just the global config and CLI options. [#1392](https://github.com/commercialhaskell/stack/issues/1392) * `stack ghci` now uses `:add` instead of `:load`, making it potentially work better with user scripts. See [#1888](https://github.com/commercialhaskell/stack/issues/1888) Other enhancements: * Grab Cabal files via Git SHA to avoid regressions from Hackage revisions [#2070](https://github.com/commercialhaskell/stack/pull/2070) * Custom snapshots now support `ghc-options`. * Package git repos are now re-used rather than re-cloned. See [#1620](https://github.com/commercialhaskell/stack/issues/1620) * `DESTDIR` is filtered from environment when installing GHC. See [#1460](https://github.com/commercialhaskell/stack/issues/1460) * `stack haddock` now supports `--hadock-arguments`. See [#2144](https://github.com/commercialhaskell/stack/issues/2144) * Signing: warn if GPG_TTY is not set as per `man gpg-agent` Bug fixes: * Now ignore project config when doing `stack init` or `stack new`. See [#2110](https://github.com/commercialhaskell/stack/issues/2110) * Packages specified by git repo can now have submodules. See [#2133](https://github.com/commercialhaskell/stack/issues/2133) * Fix of hackage index fetch retry. See re-opening of [#1418](https://github.com/commercialhaskell/stack/issues/1418#issuecomment-217633843) * HPack now picks up changes to filesystem other than package.yaml. See [#2051](https://github.com/commercialhaskell/stack/issues/2051) * "stack solver" no longer suggests --omit-packages. See [#2031](https://github.com/commercialhaskell/stack/issues/2031) * Fixed an issue with building Cabal's Setup.hs. See [#1356](https://github.com/commercialhaskell/stack/issues/1356) * Package dirtiness now pays attention to deleted files. See [#1841](https://github.com/commercialhaskell/stack/issues/1841) * `stack ghci` now uses `extra-lib-dirs` and `extra-include-dirs`. See [#1656](https://github.com/commercialhaskell/stack/issues/1656) * Relative paths outside of source dir added via `qAddDependentFile` are now checked for dirtiness. See [#1982](https://github.com/commercialhaskell/stack/issues/1982) * Signing: always use `--with-fingerprints` ## 1.1.0 Release notes: * Added Ubuntu 16.04 LTS (xenial) Apt repo. * No longer uploading new versions to Fedora 21 repo. Behavior changes: * Snapshot packages are no longer built with executable profiling. See [#1179](https://github.com/commercialhaskell/stack/issues/1179). * `stack init` now ignores symlinks when searching for cabal files. It also now ignores any directory that begins with `.` (as well as `dist` dirs) - before it would only ignore `.git`, `.stack-work`, and `dist`. * The stack executable is no longer built with `-rtsopts`. Before, when `-rtsopts` was enabled, stack would process `+RTS` options even when intended for some other program, such as when used with `stack exec -- prog +RTS`. See [#2022](https://github.com/commercialhaskell/stack/issues/2022). * The `stack path --ghc-paths` option is deprecated and renamed to `--programs`. `--compiler` is added, which points directly at the compiler used in the current project. `--compiler-bin` points to the compiler's bin dir. * For consistency with the `$STACK_ROOT` environment variable, the `stack path --global-stack-root` flag and the `global-stack-root` field in the output of `stack path` are being deprecated and replaced with the `stack-root` flag and output field. Additionally, the stack root can now be specified via the `--stack-root` command-line flag. See [#1148](https://github.com/commercialhaskell/stack/issues/1148). * `stack sig` GPG-related sub-commands were removed (folded into `upload` and `sdist`) * GPG signing of packages while uploading to Hackage is now the default. Use `upload --no-signature` if you would rather not contribute your package signature. If you don't yet have a GPG keyset, read this [blog post on GPG keys](https://fpcomplete.com/blog/2016/05/stack-security-gnupg-keys). We can add a stack.yaml config setting to disable signing if some people desire it. We hope that people will sign. Later we will be adding GPG signature verification options. * `stack build pkg-1.2.3` will now build even if the snapshot has a different package version - it is treated as an extra-dep. `stack build local-pkg-1.2.3` is an error even if the version number matches the local package [#2028](https://github.com/commercialhaskell/stack/issues/2028). * Having a `nix:` section no longer implies enabling nix build. This allows the user to globally configure whether nix is used (unless the project overrides the default explicitly). See [#1924](https://github.com/commercialhaskell/stack/issues/1924). * Remove deprecated valid-wanted field. * Docker: mount home directory in container [#1949](https://github.com/commercialhaskell/stack/issues/1949). * Deprecate `--local-bin-path` instead `--local-bin`. * `stack image`: allow absolute source paths for `add`. Other enhancements: * `stack haddock --open [PACKAGE]` opens the local haddocks in the browser. * Fix too much rebuilding when enabling/disabling profiling flags. * `stack build pkg-1.0` will now build `pkg-1.0` even if the snapshot specifies a different version (it introduces a temporary extra-dep) * Experimental support for `--split-objs` added [#1284](https://github.com/commercialhaskell/stack/issues/1284). * `git` packages with submodules are supported by passing the `--recursive` flag to `git clone`. * When using [hpack](https://github.com/sol/hpack), only regenerate cabal files when hpack files change. * hpack files can now be used in templates * `stack ghci` now runs ghci as a separate process [#1306](https://github.com/commercialhaskell/stack/issues/1306) * Retry when downloading snapshots and package indices * Many build options are configurable now in `stack.yaml`: ``` build: library-profiling: true executable-profiling: true haddock: true haddock-deps: true copy-bins: true prefetch: true force-dirty: true keep-going: true test: true test-arguments: rerun-tests: true additional-args: ['-fprof'] coverage: true no-run-tests: true bench: true benchmark-opts: benchmark-arguments: -O2 no-run-benchmarks: true reconfigure: true cabal-verbose: true ``` * A number of URLs are now configurable, useful for firewalls. See [#1794](https://github.com/commercialhaskell/stack/issues/1884). * Suggest causes when executables are missing. * Allow `--omit-packages` even without `--solver`. * Improve the generated stack.yaml. * Improve ghci results after :load Main module collision with main file path. * Only load the hackage index if necessary [#1883](https://github.com/commercialhaskell/stack/issues/1883), [#1892](https://github.com/commercialhaskell/stack/issues/1892). * init: allow local packages to be deps of deps [#1965](https://github.com/commercialhaskell/stack/issues/1965). * Always use full fingerprints from GPG [#1952](https://github.com/commercialhaskell/stack/issues/1952). * Default to using `gpg2` and fall back to `gpg` [#1976](https://github.com/commercialhaskell/stack/issues/1976). * Add a flag for --verbosity silent. * Add `haddock --open` flag [#1396](https://github.com/commercialhaskell/stack/issues/1396). Bug fixes: * Package tarballs would fail to unpack. [#1884](https://github.com/commercialhaskell/stack/issues/1884). * Fixed errant warnings about missing modules, after deleted and removed from cabal file [#921](https://github.com/commercialhaskell/stack/issues/921) [#1805](https://github.com/commercialhaskell/stack/issues/1805). * Now considers a package to dirty when the hpack file is changed [#1819](https://github.com/commercialhaskell/stack/issues/1819). * Nix: cancelling a stack build now exits properly rather than dropping into a nix-shell [#1778](https://github.com/commercialhaskell/stack/issues/1778). * `allow-newer: true` now causes `--exact-configuration` to be passed to Cabal. See [#1579](https://github.com/commercialhaskell/stack/issues/1579). * `stack solver` no longer fails with `InvalidRelFile` for relative package paths including `..`. See [#1954](https://github.com/commercialhaskell/stack/issues/1954). * Ignore emacs lock files when finding .cabal [#1897](https://github.com/commercialhaskell/stack/issues/1897). * Use lenient UTF-8 decode for build output [#1945](https://github.com/commercialhaskell/stack/issues/1945). * Clear index cache whenever index updated [#1962](https://github.com/commercialhaskell/stack/issues/1962). * Fix: Building a container image drops a .stack-work dir in the current working (sub)directory [#1975](https://github.com/commercialhaskell/stack/issues/1975). * Fix: Rebuilding when disabling profiling [#2023](https://github.com/commercialhaskell/stack/issues/2023). ## 1.0.4.3 Bug fixes: * Don't delete contents of ~/.ssh when using `stack clean --full` with Docker enabled [#2000](https://github.com/commercialhaskell/stack/issues/2000) ## 1.0.4.2 Build with path-io-1.0.0. There are no changes in behaviour from 1.0.4, so no binaries are released for this version. ## 1.0.4.1 Fixes build with aeson-0.11.0.0. There are no changes in behaviour from 1.0.4, so no binaries are released for this version. ## 1.0.4 Major changes: * Some notable changes in `stack init`: * Overall it should now be able to initialize almost all existing cabal packages out of the box as long as the package itself is consistently defined. * Choose the best possible snapshot and add extra dependencies on top of a snapshot resolver rather than a compiler resolver - [#1583](https://github.com/commercialhaskell/stack/pull/1583) * Automatically omit a package (`--omit-packages`) when it is compiler incompatible or when there are packages with conflicting dependency requirements - [#1674](https://github.com/commercialhaskell/stack/pull/1674). * Some more changes for a better user experience. Please refer to the doc guide for details. * Add support for hpack, alternative package description format [#1679](https://github.com/commercialhaskell/stack/issues/1679) Other enhancements: * Docker: pass ~/.ssh and SSH auth socket into container, so that git repos work [#1358](https://github.com/commercialhaskell/stack/issues/1358). * Docker: strip suffix from docker --version. [#1653](https://github.com/commercialhaskell/stack/issues/1653) * Docker: pass USER and PWD environment variables into container. * On each run, stack will test the stack root directory (~/.stack), and the project and package work directories (.stack-work) for whether they are owned by the current user and abort if they are not. This precaution can be disabled with the `--allow-different-user` flag or `allow-different-user` option in the global config (~/.stack/config.yaml). [#471](https://github.com/commercialhaskell/stack/issues/471) * Added `stack clean --full` option for full working dir cleanup. * YAML config: support Zip archives. * Redownload build plan if parsing fails [#1702](https://github.com/commercialhaskell/stack/issues/1702). * Give mustache templates access to a 'year' tag [#1716](https://github.com/commercialhaskell/stack/pull/1716). * Have "stack ghci" warn about module name aliasing. * Add "stack ghci --load-local-deps". * Build Setup.hs with -rtsopts [#1687](https://github.com/commercialhaskell/stack/issues/1687). * `stack init` accepts a list of directories. * Add flag infos to DependencyPlanFailures (for better error output in case of flags) [#713](https://github.com/commercialhaskell/stack/issues/713) * `stack new --bare` complains for overwrites, and add `--force` option [#1597](https://github.com/commercialhaskell/stack/issues/1597). Bug fixes: * Previously, `stack ghci` would fail with `cannot satisfy -package-id` when the implicit build step changes the package key of some dependency. * Fix: Building with ghcjs: "ghc-pkg: Prelude.chr: bad argument: 2980338" [#1665](https://github.com/commercialhaskell/stack/issues/1665). * Fix running test / bench with `--profile` / `--trace`. * Fix: build progress counter is no longer visible [#1685](https://github.com/commercialhaskell/stack/issues/1685). * Use "-RTS" w/ profiling to allow extra args [#1772](https://github.com/commercialhaskell/stack/issues/1772). * Fix withUnpackedTarball7z to find name of srcDir after unpacking (fixes `stack setup` fails for ghcjs project on windows) [#1774](https://github.com/commercialhaskell/stack/issues/1774). * Add space before auto-generated bench opts (makes profiling options work uniformly for applications and benchmark suites) [#1771](https://github.com/commercialhaskell/stack/issues/1771). * Don't try to find plugin if it resembles flag. * Setup.hs changes cause package dirtiness [#1711](https://github.com/commercialhaskell/stack/issues/1711). * Send "stack templates" output to stdout [#1792](https://github.com/commercialhaskell/stack/issues/1792). ## 1.0.2 Release notes: - Arch Linux: Stack has been adopted into the [official community repository](https://www.archlinux.org/packages/community/x86_64/stack/), so we will no longer be updating the AUR with new versions. See the [install/upgrade guide](http://docs.haskellstack.org/en/stable/install_and_upgrade/#arch-linux) for current download instructions. Major changes: - `stack init` and `solver` overhaul [#1583](https://github.com/commercialhaskell/stack/pull/1583) Other enhancements: - Disable locale/codepage hacks when GHC >=7.10.3 [#1552](https://github.com/commercialhaskell/stack/issues/1552) - Specify multiple images to build for `stack image container` [docs](http://docs.haskellstack.org/en/stable/yaml_configuration/#image) - Specify which executables to include in images for `stack image container` [docs](http://docs.haskellstack.org/en/stable/yaml_configuration/#image) - Docker: pass supplemantary groups and umask into container - If git fetch fails wipe the directory and try again from scratch [#1418](https://github.com/commercialhaskell/stack/issues/1418) - Warn if newly installed executables won't be available on the PATH [#1362](https://github.com/commercialhaskell/stack/issues/1362) - stack.yaml: for `stack image container`, specify multiple images to generate, and which executables should be added to those images - GHCI: add interactive Main selection [#1068](https://github.com/commercialhaskell/stack/issues/1068) - Care less about the particular name of a GHCJS sdist folder [#1622](https://github.com/commercialhaskell/stack/issues/1622) - Unified Enable/disable help messaging [#1613](https://github.com/commercialhaskell/stack/issues/1613) Bug fixes: - Don't share precompiled packages between GHC/platform variants and Docker [#1551](https://github.com/commercialhaskell/stack/issues/1551) - Properly redownload corrupted downloads with the correct file size. [Mailing list discussion](https://groups.google.com/d/msg/haskell-stack/iVGDG5OHYxs/FjUrR5JsDQAJ) - Gracefully handle invalid paths in error/warning messages [#1561](https://github.com/commercialhaskell/stack/issues/1561) - Nix: select the correct GHC version corresponding to the snapshot even when an abstract resolver is passed via `--resolver` on the command-line. [#1641](https://github.com/commercialhaskell/stack/issues/1641) - Fix: Stack does not allow using an external package from ghci [#1557](https://github.com/commercialhaskell/stack/issues/1557) - Disable ambiguous global '--resolver' option for 'stack init' [#1531](https://github.com/commercialhaskell/stack/issues/1531) - Obey `--no-nix` flag - Fix: GHCJS Execute.hs: Non-exhaustive patterns in lambda [#1591](https://github.com/commercialhaskell/stack/issues/1591) - Send file-watch and sticky logger messages to stderr [#1302](https://github.com/commercialhaskell/stack/issues/1302) [#1635](https://github.com/commercialhaskell/stack/issues/1635) - Use globaldb path for querying Cabal version [#1647](https://github.com/commercialhaskell/stack/issues/1647) ## 1.0.0 Release notes: * We're calling this version 1.0.0 in preparation for Stackage LTS 4. Note, however, that this does not mean the code's API will be stable as this is primarily an end-user tool. Enhancements: * Added flag `--profile` flag: passed with `stack build`, it will enable profiling, and for `--bench` and `--test` it will generate a profiling report by passing `+RTS -p` to the executable(s). Great for using like `stack build --bench --profile` (remember that enabling profile will slow down your benchmarks by >4x). Run `stack build --bench` again to disable the profiling and get proper speeds * Added flag `--trace` flag: just like `--profile`, it enables profiling, but instead of generating a report for `--bench` and `--test`, prints out a stack trace on exception. Great for using like `stack build --test --trace` * Nix: all options can be overriden on command line [#1483](https://github.com/commercialhaskell/stack/issues/1483) * Nix: build environments (shells) are now pure by default. * Make verbosity silent by default in script interpreter mode [#1472](https://github.com/commercialhaskell/stack/issues/1472) * Show a message when resetting git commit fails [#1453](https://github.com/commercialhaskell/stack/issues/1453) * Improve Unicode handling in project/package names [#1337](https://github.com/commercialhaskell/stack/issues/1337) * Fix ambiguity between a stack command and a filename to execute (prefer `stack` subcommands) [#1471](https://github.com/commercialhaskell/stack/issues/1471) * Support multi line interpreter directive comments [#1394](https://github.com/commercialhaskell/stack/issues/1394) * Handle space separated pids in ghc-pkg dump (for GHC HEAD) [#1509](https://github.com/commercialhaskell/stack/issues/1509) * Add ghci --no-package-hiding option [#1517](https://github.com/commercialhaskell/stack/issues/1517) * `stack new` can download templates from URL [#1466](https://github.com/commercialhaskell/stack/issues/1466) Bug fixes: * Nix: stack exec options are passed properly to the stack sub process [#1538](https://github.com/commercialhaskell/stack/issues/1538) * Nix: specifying a shell-file works in any current working directory [#1547](https://github.com/commercialhaskell/stack/issues/1547) * Nix: use `--resolver` argument * Docker: fix missing image message and '--docker-auto-pull' * No HTML escaping for "stack new" template params [#1475](https://github.com/commercialhaskell/stack/issues/1475) * Set permissions for generated .ghci script [#1480](https://github.com/commercialhaskell/stack/issues/1480) * Restrict commands allowed in interpreter mode [#1504](https://github.com/commercialhaskell/stack/issues/1504) * stack ghci doesn't see preprocessed files for executables [#1347](https://github.com/commercialhaskell/stack/issues/1347) * All test suites run even when only one is requested [#1550](https://github.com/commercialhaskell/stack/pull/1550) * Edge cases in broken templates give odd errors [#1535](https://github.com/commercialhaskell/stack/issues/1535) * Fix test coverage bug on windows ## 0.1.10.1 Bug fixes: * `stack image container` did not actually build an image [#1473](https://github.com/commercialhaskell/stack/issues/1473) ## 0.1.10.0 Release notes: * The Stack home page is now at [haskellstack.org](http://haskellstack.org), which shows the documentation rendered by readthedocs.org. Note: this has necessitated some changes to the links in the documentation's markdown source code, so please check the links on the website before submitting a PR to fix them. * The locations of the [Ubuntu](http://docs.haskellstack.org/en/stable/install_and_upgrade/#ubuntu) and [Debian](http://docs.haskellstack.org/en/stable/install_and_upgrade/#debian) package repositories have changed to have correct URL semantics according to Debian's guidelines [#1378](https://github.com/commercialhaskell/stack/issues/1378). The old locations will continue to work for some months, but we suggest that you adjust your `/etc/apt/sources.list.d/fpco.list` to the new location to avoid future disruption. * [openSUSE and SUSE Linux Enterprise](http://docs.haskellstack.org/en/stable/install_and_upgrade/#suse) packages are now available, thanks to [@mimi1vx](https://github.com/mimi1vx). Note: there will be some lag before these pick up new versions, as they are based on Stackage LTS. Major changes: * Support for building inside a Nix-shell providing system dependencies [#1285](https://github.com/commercialhaskell/stack/pull/1285) * Add optional GPG signing on `stack upload --sign` or with `stack sig sign ...` Other enhancements: * Print latest applicable version of packages on conflicts [#508](https://github.com/commercialhaskell/stack/issues/508) * Support for packages located in Mercurial repositories [#1397](https://github.com/commercialhaskell/stack/issues/1397) * Only run benchmarks specified as build targets [#1412](https://github.com/commercialhaskell/stack/issues/1412) * Support git-style executable fall-through (`stack something` executes `stack-something` if present) [#1433](https://github.com/commercialhaskell/stack/issues/1433) * GHCi now loads intermediate dependencies [#584](https://github.com/commercialhaskell/stack/issues/584) * `--work-dir` option for overriding `.stack-work` [#1178](https://github.com/commercialhaskell/stack/issues/1178) * Support `detailed-0.9` tests [#1429](https://github.com/commercialhaskell/stack/issues/1429) * Docker: improved POSIX signal proxying to containers [#547](https://github.com/commercialhaskell/stack/issues/547) Bug fixes: * Show absolute paths in error messages in multi-package builds [#1348](https://github.com/commercialhaskell/stack/issues/1348) * Docker-built binaries and libraries in different path [#911](https://github.com/commercialhaskell/stack/issues/911) [#1367](https://github.com/commercialhaskell/stack/issues/1367) * Docker: `--resolver` argument didn't effect selected image tag * GHCi: Spaces in filepaths caused module loading issues [#1401](https://github.com/commercialhaskell/stack/issues/1401) * GHCi: cpp-options in cabal files weren't used [#1419](https://github.com/commercialhaskell/stack/issues/1419) * Benchmarks couldn't be run independently of eachother [#1412](https://github.com/commercialhaskell/stack/issues/1412) * Send output of building setup to stderr [#1410](https://github.com/commercialhaskell/stack/issues/1410) ## 0.1.8.0 Major changes: * GHCJS can now be used with stackage snapshots via the new `compiler` field. * Windows installers are now available: [download them here](http://docs.haskellstack.org/en/stable/install_and_upgrade/#windows) [#613](https://github.com/commercialhaskell/stack/issues/613) * Docker integration works with non-FPComplete generated images [#531](https://github.com/commercialhaskell/stack/issues/531) Other enhancements: * Added an `allow-newer` config option [#922](https://github.com/commercialhaskell/stack/issues/922) [#770](https://github.com/commercialhaskell/stack/issues/770) * When a Hackage revision invalidates a build plan in a snapshot, trust the snapshot [#770](https://github.com/commercialhaskell/stack/issues/770) * Added a `stack config set resolver RESOLVER` command. Part of work on [#115](https://github.com/commercialhaskell/stack/issues/115) * `stack setup` can now install GHCJS on windows. See [#1145](https://github.com/commercialhaskell/stack/issues/1145) and [#749](https://github.com/commercialhaskell/stack/issues/749) * `stack hpc report` command added, which generates reports for HPC tix files * `stack ghci` now accepts all the flags accepted by `stack build`. See [#1186](https://github.com/commercialhaskell/stack/issues/1186) * `stack ghci` builds the project before launching GHCi. If the build fails, optimistically launch GHCi anyway. Use `stack ghci --no-build` option to disable [#1065](https://github.com/commercialhaskell/stack/issues/1065) * `stack ghci` now detects and warns about various circumstances where it is liable to fail. See [#1270](https://github.com/commercialhaskell/stack/issues/1270) * Added `require-docker-version` configuration option * Packages will now usually be built along with their tests and benchmarks. See [#1166](https://github.com/commercialhaskell/stack/issues/1166) * Relative `local-bin-path` paths will be relative to the project's root directory, not the current working directory. [#1340](https://github.com/commercialhaskell/stack/issues/1340) * `stack clean` now takes an optional `[PACKAGE]` argument for use in multi-package projects. See [#583](https://github.com/commercialhaskell/stack/issues/583) * Ignore cabal_macros.h as a dependency [#1195](https://github.com/commercialhaskell/stack/issues/1195) * Pad timestamps and show local time in --verbose output [#1226](https://github.com/commercialhaskell/stack/issues/1226) * GHCi: Import all modules after loading them [#995](https://github.com/commercialhaskell/stack/issues/995) * Add subcommand aliases: `repl` for `ghci`, and `runhaskell` for `runghc` [#1241](https://github.com/commercialhaskell/stack/issues/1241) * Add typo recommendations for unknown package identifiers [#158](https://github.com/commercialhaskell/stack/issues/158) * Add `stack path --local-hpc-root` option * Overhaul dependencies' haddocks copying [#1231](https://github.com/commercialhaskell/stack/issues/1231) * Support for extra-package-dbs in 'stack ghci' [#1229](https://github.com/commercialhaskell/stack/pull/1229) * `stack new` disallows package names with "words" consisting solely of numbers [#1336](https://github.com/commercialhaskell/stack/issues/1336) * `stack build --fast` turns off optimizations * Show progress while downloading package index [#1223](https://github.com/commercialhaskell/stack/issues/1223). Bug fixes: * Fix: Haddocks not copied for dependencies [#1105](https://github.com/commercialhaskell/stack/issues/1105) * Fix: Global options did not work consistently after subcommand [#519](https://github.com/commercialhaskell/stack/issues/519) * Fix: 'stack ghci' doesn't notice that a module got deleted [#1180](https://github.com/commercialhaskell/stack/issues/1180) * Rebuild when cabal file is changed * Fix: Paths in GHC warnings not canonicalized, nor those for packages in subdirectories or outside the project root [#1259](https://github.com/commercialhaskell/stack/issues/1259) * Fix: unlisted files in tests and benchmarks trigger extraneous second build [#838](https://github.com/commercialhaskell/stack/issues/838) ## 0.1.6.0 Major changes: * `stack setup` now supports building and booting GHCJS from source tarball. * On Windows, build directories no longer display "pretty" information (like x86_64-windows/Cabal-1.22.4.0), but rather a hash of that content. The reason is to avoid the 260 character path limitation on Windows. See [#1027](https://github.com/commercialhaskell/stack/pull/1027) * Rename config files and clarify their purposes [#969](https://github.com/commercialhaskell/stack/issues/969) * `~/.stack/stack.yaml` --> `~/.stack/config.yaml` * `~/.stack/global` --> `~/.stack/global-project` * `/etc/stack/config` --> `/etc/stack/config.yaml` * Old locations still supported, with deprecation warnings * New command "stack eval CODE", which evaluates to "stack exec ghc -- -e CODE". Other enhancements: * No longer install `git` on Windows [#1046](https://github.com/commercialhaskell/stack/issues/1046). You can still get this behavior by running the following yourself: `stack exec -- pacman -Sy --noconfirm git`. * Typing enter during --file-watch triggers a rebuild [#1023](https://github.com/commercialhaskell/stack/pull/1023) * Use Haddock's `--hyperlinked-source` (crosslinked source), if available [#1070](https://github.com/commercialhaskell/stack/pull/1070) * Use Stack-installed GHCs for `stack init --solver` [#1072](https://github.com/commercialhaskell/stack/issues/1072) * New experimental `stack query` command [#1087](https://github.com/commercialhaskell/stack/issues/1087) * By default, stack no longer rebuilds a package due to GHC options changes. This behavior can be tweaked with the `rebuild-ghc-options` setting. [#1089](https://github.com/commercialhaskell/stack/issues/1089) * By default, ghc-options are applied to all local packages, not just targets. This behavior can be tweaked with the `apply-ghc-options` setting. [#1089](https://github.com/commercialhaskell/stack/issues/1089) * Docker: download or override location of stack executable to re-run in container [#974](https://github.com/commercialhaskell/stack/issues/974) * Docker: when Docker Engine is remote, don't run containerized processes as host's UID/GID [#194](https://github.com/commercialhaskell/stack/issues/194) * Docker: `set-user` option to enable/disable running containerized processes as host's UID/GID [#194](https://github.com/commercialhaskell/stack/issues/194) * Custom Setup.hs files are now precompiled instead of interpreted. This should be a major performance win for certain edge cases (biggest example: [building Cabal itself](https://github.com/commercialhaskell/stack/issues/1041)) while being either neutral or a minor slowdown for more common cases. * `stack test --coverage` now also generates a unified coverage report for multiple test-suites / packages. In the unified report, test-suites can contribute to the coverage of other packages. Bug fixes: * Ignore stack-built executables named `ghc` [#1052](https://github.com/commercialhaskell/stack/issues/1052) * Fix quoting of output failed command line arguments * Mark executable-only packages as installed when copied from cache [#1043](https://github.com/commercialhaskell/stack/pull/1043) * Canonicalize temporary directory paths [#1047](https://github.com/commercialhaskell/stack/pull/1047) * Put code page fix inside the build function itself [#1066](https://github.com/commercialhaskell/stack/issues/1066) * Add `explicit-setup-deps` option [#1110](https://github.com/commercialhaskell/stack/issues/1110), and change the default to the old behavior of using any package in the global and snapshot database [#1025](https://github.com/commercialhaskell/stack/issues/1025) * Precompiled cache checks full package IDs on Cabal < 1.22 [#1103](https://github.com/commercialhaskell/stack/issues/1103) * Pass -package-id to ghci [#867](https://github.com/commercialhaskell/stack/issues/867) * Ignore global packages when copying precompiled packages [#1146](https://github.com/commercialhaskell/stack/issues/1146) ## 0.1.5.0 Major changes: * On Windows, we now use a full MSYS2 installation in place of the previous PortableGit. This gives you access to the pacman package manager for more easily installing libraries. * Support for custom GHC binary distributions [#530](https://github.com/commercialhaskell/stack/issues/530) * `ghc-variant` option in stack.yaml to specify the variant (also `--ghc-variant` command-line option) * `setup-info` in stack.yaml, to specify where to download custom binary distributions (also `--ghc-bindist` command-line option) * Note: On systems with libgmp4 (aka `libgmp.so.3`), such as CentOS 6, you may need to re-run `stack setup` due to the centos6 GHC bindist being treated like a variant * A new `--pvp-bounds` flag to the sdist and upload commands allows automatic adding of PVP upper and/or lower bounds to your dependencies Other enhancements: * Adapt to upcoming Cabal installed package identifier format change [#851](https://github.com/commercialhaskell/stack/issues/851) * `stack setup` takes a `--stack-setup-yaml` argument * `--file-watch` is more discerning about which files to rebuild for [#912](https://github.com/commercialhaskell/stack/issues/912) * `stack path` now supports `--global-pkg-db` and `--ghc-package-path` * `--reconfigure` flag [#914](https://github.com/commercialhaskell/stack/issues/914) [#946](https://github.com/commercialhaskell/stack/issues/946) * Cached data is written with a checksum of its structure [#889](https://github.com/commercialhaskell/stack/issues/889) * Fully removed `--optimizations` flag * Added `--cabal-verbose` flag * Added `--file-watch-poll` flag for polling instead of using filesystem events (useful for running tests in a Docker container while modifying code in the host environment. When code is injected into the container via a volume, the container won't propagate filesystem events). * Give a preemptive error message when `-prof` is given as a GHC option [#1015](https://github.com/commercialhaskell/stack/issues/1015) * Locking is now optional, and will be turned on by setting the `STACK_LOCK` environment variable to `true` [#950](https://github.com/commercialhaskell/stack/issues/950) * Create default stack.yaml with documentation comments and commented out options [#226](https://github.com/commercialhaskell/stack/issues/226) * Out of memory warning if Cabal exits with -9 [#947](https://github.com/commercialhaskell/stack/issues/947) Bug fixes: * Hacky workaround for optparse-applicative issue with `stack exec --help` [#806](https://github.com/commercialhaskell/stack/issues/806) * Build executables for local extra deps [#920](https://github.com/commercialhaskell/stack/issues/920) * copyFile can't handle directories [#942](https://github.com/commercialhaskell/stack/pull/942) * Support for spaces in Haddock interface files [fpco/minghc#85](https://github.com/fpco/minghc/issues/85) * Temporarily building against a "shadowing" local package? [#992](https://github.com/commercialhaskell/stack/issues/992) * Fix Setup.exe name for --upgrade-cabal on Windows [#1002](https://github.com/commercialhaskell/stack/issues/1002) * Unlisted dependencies no longer trigger extraneous second build [#838](https://github.com/commercialhaskell/stack/issues/838) ## 0.1.4.1 Fix stack's own Haddocks. No changes to functionality (only comments updated). ## 0.1.4.0 Major changes: * You now have more control over how GHC versions are matched, e.g. "use exactly this version," "use the specified minor version, but allow patches," or "use the given minor version or any later minor in the given major release." The default has switched from allowing newer later minor versions to a specific minor version allowing patches. For more information, see [#736](https://github.com/commercialhaskell/stack/issues/736) and [#784](https://github.com/commercialhaskell/stack/pull/784). * Support added for compiling with GHCJS * stack can now reuse prebuilt binaries between snapshots. That means that, if you build package foo in LTS-3.1, that binary version can be reused in LTS-3.2, assuming it uses the same dependencies and flags. [#878](https://github.com/commercialhaskell/stack/issues/878) Other enhancements: * Added the `--docker-env` argument, to set environment variables in Docker container. * Set locale environment variables to UTF-8 encoding for builds to avoid "commitBuffer: invalid argument" errors from GHC [#793](https://github.com/commercialhaskell/stack/issues/793) * Enable translitation for encoding on stdout and stderr [#824](https://github.com/commercialhaskell/stack/issues/824) * By default, `stack upgrade` automatically installs GHC as necessary [#797](https://github.com/commercialhaskell/stack/issues/797) * Added the `ghc-options` field to stack.yaml [#796](https://github.com/commercialhaskell/stack/issues/796) * Added the `extra-path` field to stack.yaml * Code page changes on Windows only apply to the build command (and its synonyms), and can be controlled via a command line flag (still defaults to on) [#757](https://github.com/commercialhaskell/stack/issues/757) * Implicitly add packages to extra-deps when a flag for them is set [#807](https://github.com/commercialhaskell/stack/issues/807) * Use a precompiled Setup.hs for simple build types [#801](https://github.com/commercialhaskell/stack/issues/801) * Set --enable-tests and --enable-benchmarks optimistically [#805](https://github.com/commercialhaskell/stack/issues/805) * `--only-configure` option added [#820](https://github.com/commercialhaskell/stack/issues/820) * Check for duplicate local package names * Stop nagging people that call `stack test` [#845](https://github.com/commercialhaskell/stack/issues/845) * `--file-watch` will ignore files that are in your VCS boring/ignore files [#703](https://github.com/commercialhaskell/stack/issues/703) * Add `--numeric-version` option Bug fixes: * `stack init --solver` fails if `GHC_PACKAGE_PATH` is present [#860](https://github.com/commercialhaskell/stack/issues/860) * `stack solver` and `stack init --solver` check for test suite and benchmark dependencies [#862](https://github.com/commercialhaskell/stack/issues/862) * More intelligent logic for setting UTF-8 locale environment variables [#856](https://github.com/commercialhaskell/stack/issues/856) * Create missing directories for `stack sdist` * Don't ignore .cabal files with extra periods [#895](https://github.com/commercialhaskell/stack/issues/895) * Deprecate unused `--optimizations` flag * Truncated output on slow terminals [#413](https://github.com/commercialhaskell/stack/issues/413) ## 0.1.3.1 Bug fixes: * Ignore disabled executables [#763](https://github.com/commercialhaskell/stack/issues/763) ## 0.1.3.0 Major changes: * Detect when a module is compiled but not listed in the cabal file ([#32](https://github.com/commercialhaskell/stack/issues/32)) * A warning is displayed for any modules that should be added to `other-modules` in the .cabal file * These modules are taken into account when determining whether a package needs to be built * Respect TemplateHaskell addDependentFile dependency changes ([#105](https://github.com/commercialhaskell/stack/issues/105)) * TH dependent files are taken into account when determining whether a package needs to be built. * Overhauled target parsing, added `--test` and `--bench` options [#651](https://github.com/commercialhaskell/stack/issues/651) * For details, see [Build commands documentation](http://docs.haskellstack.org/en/stable/build_command/) Other enhancements: * Set the `HASKELL_DIST_DIR` environment variable [#524](https://github.com/commercialhaskell/stack/pull/524) * Track build status of tests and benchmarks [#525](https://github.com/commercialhaskell/stack/issues/525) * `--no-run-tests` [#517](https://github.com/commercialhaskell/stack/pull/517) * Targets outside of root dir don't build [#366](https://github.com/commercialhaskell/stack/issues/366) * Upper limit on number of flag combinations to test [#543](https://github.com/commercialhaskell/stack/issues/543) * Fuzzy matching support to give better error messages for close version numbers [#504](https://github.com/commercialhaskell/stack/issues/504) * `--local-bin-path` global option. Use to change where binaries get placed on a `--copy-bins` [#342](https://github.com/commercialhaskell/stack/issues/342) * Custom snapshots [#111](https://github.com/commercialhaskell/stack/issues/111) * --force-dirty flag: Force treating all local packages as having dirty files (useful for cases where stack can't detect a file change) * GHC error messages: display file paths as absolute instead of relative for better editor integration * Add the `--copy-bins` option [#569](https://github.com/commercialhaskell/stack/issues/569) * Give warnings on unexpected config keys [#48](https://github.com/commercialhaskell/stack/issues/48) * Remove Docker `pass-host` option * Don't require cabal-install to upload [#313](https://github.com/commercialhaskell/stack/issues/313) * Generate indexes for all deps and all installed snapshot packages [#143](https://github.com/commercialhaskell/stack/issues/143) * Provide `--resolver global` option [#645](https://github.com/commercialhaskell/stack/issues/645) * Also supports `--resolver nightly`, `--resolver lts`, and `--resolver lts-X` * Make `stack build --flag` error when flag or package is unknown [#617](https://github.com/commercialhaskell/stack/issues/617) * Preserve file permissions when unpacking sources [#666](https://github.com/commercialhaskell/stack/pull/666) * `stack build` etc work outside of a project * `list-dependencies` command [#638](https://github.com/commercialhaskell/stack/issues/638) * `--upgrade-cabal` option to `stack setup` [#174](https://github.com/commercialhaskell/stack/issues/174) * `--exec` option [#651](https://github.com/commercialhaskell/stack/issues/651) * `--only-dependencies` implemented correctly [#387](https://github.com/commercialhaskell/stack/issues/387) Bug fixes: * Extensions from the `other-extensions` field no longer enabled by default [#449](https://github.com/commercialhaskell/stack/issues/449) * Fix: haddock forces rebuild of empty packages [#452](https://github.com/commercialhaskell/stack/issues/452) * Don't copy over executables excluded by component selection [#605](https://github.com/commercialhaskell/stack/issues/605) * Fix: stack fails on Windows with git package in stack.yaml and no git binary on path [#712](https://github.com/commercialhaskell/stack/issues/712) * Fixed GHCi issue: Specifying explicit package versions (#678) * Fixed GHCi issue: Specifying -odir and -hidir as .stack-work/odir (#529) * Fixed GHCi issue: Specifying A instead of A.ext for modules (#498) ## 0.1.2.0 * Add `--prune` flag to `stack dot` [#487](https://github.com/commercialhaskell/stack/issues/487) * Add `--[no-]external`,`--[no-]include-base` flags to `stack dot` [#437](https://github.com/commercialhaskell/stack/issues/437) * Add `--ignore-subdirs` flag to init command [#435](https://github.com/commercialhaskell/stack/pull/435) * Handle attempt to use non-existing resolver [#436](https://github.com/commercialhaskell/stack/pull/436) * Add `--force` flag to `init` command * exec style commands accept the `--package` option (see [Reddit discussion](http://www.reddit.com/r/haskell/comments/3bd66h/stack_runghc_turtle_as_haskell_script_solution/)) * `stack upload` without arguments doesn't do anything [#439](https://github.com/commercialhaskell/stack/issues/439) * Print latest version of packages on conflicts [#450](https://github.com/commercialhaskell/stack/issues/450) * Flag to avoid rerunning tests that haven't changed [#451](https://github.com/commercialhaskell/stack/issues/451) * stack can act as a script interpreter (see [Script interpreter] (https://github.com/commercialhaskell/stack/wiki/Script-interpreter) and [Reddit discussion](http://www.reddit.com/r/haskell/comments/3bd66h/stack_runghc_turtle_as_haskell_script_solution/)) * Add the __`--file-watch`__ flag to auto-rebuild on file changes [#113](https://github.com/commercialhaskell/stack/issues/113) * Rename `stack docker exec` to `stack exec --plain` * Add the `--skip-msys` flag [#377](https://github.com/commercialhaskell/stack/issues/377) * `--keep-going`, turned on by default for tests and benchmarks [#478](https://github.com/commercialhaskell/stack/issues/478) * `concurrent-tests: BOOL` [#492](https://github.com/commercialhaskell/stack/issues/492) * Use hashes to check file dirtiness [#502](https://github.com/commercialhaskell/stack/issues/502) * Install correct GHC build on systems with libgmp.so.3 [#465](https://github.com/commercialhaskell/stack/issues/465) * `stack upgrade` checks version before upgrading [#447](https://github.com/commercialhaskell/stack/issues/447) ## 0.1.1.0 * Remove GHC uncompressed tar file after installation [#376](https://github.com/commercialhaskell/stack/issues/376) * Put stackage snapshots JSON on S3 [#380](https://github.com/commercialhaskell/stack/issues/380) * Specifying flags for multiple packages [#335](https://github.com/commercialhaskell/stack/issues/335) * single test suite failure should show entire log [#388](https://github.com/commercialhaskell/stack/issues/388) * valid-wanted is a confusing option name [#386](https://github.com/commercialhaskell/stack/issues/386) * stack init in multi-package project should use local packages for dependency checking [#384](https://github.com/commercialhaskell/stack/issues/384) * Display information on why a snapshot was rejected [#381](https://github.com/commercialhaskell/stack/issues/381) * Give a reason for unregistering packages [#389](https://github.com/commercialhaskell/stack/issues/389) * `stack exec` accepts the `--no-ghc-package-path` parameter * Don't require build plan to upload [#400](https://github.com/commercialhaskell/stack/issues/400) * Specifying test components only builds/runs those tests [#398](https://github.com/commercialhaskell/stack/issues/398) * `STACK_EXE` environment variable * Add the `stack dot` command * `stack upgrade` added [#237](https://github.com/commercialhaskell/stack/issues/237) * `--stack-yaml` command line flag [#378](https://github.com/commercialhaskell/stack/issues/378) * `--skip-ghc-check` command line flag [#423](https://github.com/commercialhaskell/stack/issues/423) Bug fixes: * Haddock links to global packages no longer broken on Windows [#375](https://github.com/commercialhaskell/stack/issues/375) * Make flags case-insensitive [#397](https://github.com/commercialhaskell/stack/issues/397) * Mark packages uninstalled before rebuilding [#365](https://github.com/commercialhaskell/stack/issues/365) ## 0.1.0.0 * Fall back to cabal dependency solver when a snapshot can't be found * Basic implementation of `stack new` [#137](https://github.com/commercialhaskell/stack/issues/137) * `stack solver` command [#364](https://github.com/commercialhaskell/stack/issues/364) * `stack path` command [#95](https://github.com/commercialhaskell/stack/issues/95) * Haddocks [#143](https://github.com/commercialhaskell/stack/issues/143): * Build for dependencies * Use relative links * Generate module contents and index for all packages in project ## 0.0.3 * `--prefetch` [#297](https://github.com/commercialhaskell/stack/issues/297) * `upload` command ported from stackage-upload [#225](https://github.com/commercialhaskell/stack/issues/225) * `--only-snapshot` [#310](https://github.com/commercialhaskell/stack/issues/310) * `--resolver` [#224](https://github.com/commercialhaskell/stack/issues/224) * `stack init` [#253](https://github.com/commercialhaskell/stack/issues/253) * `--extra-include-dirs` and `--extra-lib-dirs` [#333](https://github.com/commercialhaskell/stack/issues/333) * Specify intra-package target [#201](https://github.com/commercialhaskell/stack/issues/201) ## 0.0.2 * Fix some Windows specific bugs [#216](https://github.com/commercialhaskell/stack/issues/216) * Improve output for package index updates [#227](https://github.com/commercialhaskell/stack/issues/227) * Automatically update indices as necessary [#227](https://github.com/commercialhaskell/stack/issues/227) * --verbose flag [#217](https://github.com/commercialhaskell/stack/issues/217) * Remove packages (HTTPS and Git) [#199](https://github.com/commercialhaskell/stack/issues/199) * Config values for system-ghc and install-ghc * Merge `stack deps` functionality into `stack build` * `install` command [#153](https://github.com/commercialhaskell/stack/issues/153) and [#272](https://github.com/commercialhaskell/stack/issues/272) * overriding architecture value (useful to force 64-bit GHC on Windows, for example) * Overhauled test running (allows cycles, avoids unnecessary recompilation, etc) ## 0.0.1 * First public release, beta quality stack-1.1.2/doc/CONTRIBUTING.md0000644000000000000000000000722012717707440014016 0ustar0000000000000000# Contributors Guide ## Bug Reports Before reporting a bug, please ensure that you are using the latest release (currently stack-1.1.2). See the [upgrade instructions](http://docs.haskellstack.org/en/stable/install_and_upgrade/#upgrade) to upgrade. When reporting a bug, please write in the following format: > [Any general summary/comments if desired] > **Steps to reproduce:** > 1. _Remove directory *blah*._ > 2. _Run command `stack blah`._ > 3. _Edit file blah._ > 3. _Run command `stack blah`._ > **Expected:** > _What I expected to see and happen._ > **Actual:** > _What actually happened._ > > Here is the `stack --version` output: > > ``` > $ stack --version > Version 0.0.2, Git revision 6a86ee32e5b869a877151f74064572225e1a0398 > ``` > Here is the command I ran **with `--verbose`**: > > ``` > $ stack --verbose > > ``` With `--verbose` mode we can see what the tool is doing and when. Without this output it is much more difficult to surmise what's going on with your issue. If the above output is larger than a page, paste it in a private [Gist](https://gist.github.com/) instead. Include any `.yaml` configuration if relevant. The more detailed your report, the faster it can be resolved and will ensure it is resolved in the right way. Once your bug has been resolved, the responsible will tag the issue as _Needs confirmation_ and assign the issue back to you. Once you have tested and confirmed that the issue is resolved, close the issue. If you are not a member of the project, you will be asked for confirmation and we will close it. ## Documentation If you would like to help with documentation, please note that for most cases the Wiki has been deprecated in favor of markdown files placed in a new `/doc` subdirectory of the repository itself. Please submit a [pull request](https://help.github.com/articles/using-pull-requests/) with your changes/additions. The documentation is rendered on [haskellstack.org](http://haskellstack.org) by readthedocs.org using Sphinx and CommonMark. Since links and formatting vary from GFM, please check the documentation there before submitting a PR to fix those. In particular, links to other documentation files intentionally have `.html` extensions instead of `.md`, unfortunately (see [#1506](https://github.com/commercialhaskell/stack/issues/1506) for details). If your changes move or rename files, or subsume Wiki content, please continue to leave a file/page in the old location temporarily, in addition to the new location. This will allow users time to update any shared links to the old location. Please also update any links in other files, or on the Wiki, to point to the new file location. ## Code If you would like to contribute code to fix a bug, add a new feature, or otherwise improve `stack`, pull requests are most welcome. It's a good idea to [submit an issue](https://github.com/commercialhaskell/stack/issues/new) to discuss the change before plowing into writing code. If you'd like to help out but aren't sure what to work on, look for issues with the [awaiting pr](https://github.com/commercialhaskell/stack/issues?q=is%3Aopen+is%3Aissue+label%3A%22awaiting+pr%22) label. Issues that are suitable for newcomers to the codebase have the [newcomer](https://github.com/commercialhaskell/stack/issues?q=is%3Aopen+is%3Aissue+label%3A%22awaiting+pr%22+label%3Anewcomer) label. Best to post a comment to the issue before you start work, in case anyone has already started. Please include a [ChangeLog](https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md) entry and [documentation](https://github.com/commercialhaskell/stack/tree/master/doc/) updates with your pull request. stack-1.1.2/doc/dependency_visualization.md0000644000000000000000000000423212630674604017205 0ustar0000000000000000# Dependency visualization You can use stack to visualize the dependencies between your packages and optionally also external dependencies. As an example, let's look at `wreq`: ``` $ stack dot | dot -Tpng -o wreq.png ``` [![wreq](https://cloud.githubusercontent.com/assets/591567/8478591/ae10a418-20d2-11e5-8945-55246dcfac62.png)](https://cloud.githubusercontent.com/assets/591567/8478591/ae10a418-20d2-11e5-8945-55246dcfac62.png) Okay that is a little boring, let's also look at external dependencies: ``` $ stack dot --external | dot -Tpng -o wreq.png ``` [![wreq_ext](https://cloud.githubusercontent.com/assets/591567/8478621/d247247e-20d2-11e5-993d-79096e382abd.png)](https://cloud.githubusercontent.com/assets/591567/8478621/d247247e-20d2-11e5-993d-79096e382abd.png) Well that is certainly a lot. As a start we can exclude `base` and then depending on our needs we can either limit the depth: ``` $ stack dot --no-include-base --external --depth 1 | dot -Tpng -o wreq.png ``` [![wreq_depth](https://cloud.githubusercontent.com/assets/591567/8484310/45b399a0-20f7-11e5-8068-031c2b352961.png)](https://cloud.githubusercontent.com/assets/591567/8484310/45b399a0-20f7-11e5-8068-031c2b352961.png) or prune packages explicitly: ``` $ stack dot --external --prune base,lens,wreq-examples,http-client,aeson,tls,http-client-tls,exceptions | dot -Tpng -o wreq_pruned.png ``` [![wreq_pruned](https://cloud.githubusercontent.com/assets/591567/8478768/adbad280-20d3-11e5-9992-914dc24fe569.png)](https://cloud.githubusercontent.com/assets/591567/8478768/adbad280-20d3-11e5-9992-914dc24fe569.png) Keep in mind that you can also save the dot file: ``` $ stack dot --external --depth 1 > wreq.dot $ dot -Tpng -o wreq.png wreq.dot ``` and pass in options to `dot` or use another graph layout engine like `twopi`: ``` $ stack dot --external --prune base,lens,wreq-examples,http-client,aeson,tls,http-client-tls,exceptions | twopi -Groot=wreq -Goverlap=false -Tpng -o wreq_pruned.png ``` [![wreq_pruned](https://cloud.githubusercontent.com/assets/591567/8495538/9fae1184-216e-11e5-9931-99e6147f8aed.png)](https://cloud.githubusercontent.com/assets/591567/8495538/9fae1184-216e-11e5-9931-99e6147f8aed.png) stack-1.1.2/doc/docker_integration.md0000644000000000000000000005267012717707440015772 0ustar0000000000000000Docker integration =============================================================================== `stack` has support for automatically performing builds inside a Docker container, using volume mounts and user ID switching to make it mostly seamless. FP Complete provides images for use with stack that include GHC, tools, and optionally have all of the Stackage LTS packages pre-installed in the global package database. The primary purpose for using stack/docker this way is for teams to ensure all developers are building in an exactly consistent environment without team members needing to deal with Docker themselves. See the [how stack can use Docker under the hood](https://www.fpcomplete.com/blog/2015/08/stack-docker) blog post for more information about the motivation and implementation of stack's Docker support. Usage ------------------------------------------------------------------------------- This section assumes that you already have Docker installed and working. If not, see the [prerequisites](#prerequisites) section. If you run into any trouble, see the [troubleshooting](#troubleshooting) section. ### Enable in stack.yaml The most basic configuration is to add this to your project's `stack.yaml`: docker: enable: true See [configuration](#configuration) for additional options. ### Use stack as normal With Docker enabled, most stack sub-commands will automatically launch themselves in an ephemeral Docker container (the container is deleted as soon as the command completes). The project directory and `~/.stack` are volume-mounted into the container, so any build artifacts are "permanent" (not deleted with the container). The first time you run a command with a new image, you will be prompted to run `stack docker pull` to pull the image first. This will pull a Docker image with a tag that matches your resolver. Only LTS resolvers are supported (we do not generate images for nightly snapshots). Not every LTS version is guaranteed to have an image existing, and new LTS images tend to lag behind the LTS snapshot being published on stackage.org. Be warned: these images are rather large! Docker sub-commands ------------------------------------------------------------------------------- These `stack docker` sub-commands have Docker-specific functionality. Most other `stack` commands will also use a Docker container under the surface if Docker is enabled. ### pull - Pull latest version of image `stack docker pull` pulls an image from the Docker registry for the first time, or updates the image by pulling the latest version. ### cleanup - Clean up old images and containers Docker images can take up quite a lot of disk space, and it's easy for them to build up if you switch between projects or your projects update their images. This sub-command will help to remove old images and containers. By default, `stack docker cleanup` will bring up an editor showing the images and containers on your system, with any stack images that haven't been used in the last seven days marked for removal. You can add or remove the `R` in the left-most column to flag or unflag an image/container for removal. When you save the file and quit the text editor, those images marked for removal will be deleted from your system. If you wish to abort the cleanup, delete all the lines from your editor. If you use Docker for purposes other than stack, you may have other images on your system as well. These will also appear in a separate section, but they will not be marked for removal by default. Run `stack docker cleanup --help` to see additional options to customize its behaviour. ### reset - Reset the Docker "sandbox" In order to preserve the contents of the in-container home directory between runs, a special "sandbox" directory is volume-mounted into the container. `stack docker reset` will reset that sandbox to its defaults. Note: `~/.stack` is separately volume-mounted, and is left alone during reset. Command-line options ------------------------------------------------------------------------------- The default Docker configuration can be overridden on the command-line. See `stack --docker-help` for a list of all Docker options, and consult [configuration](#configuration) section below for more information about their meanings. These are global options, and apply to all commands (not just `stack docker` sub-commands). Configuration ------------------------------------------------------------------------------- `stack.yaml` contains a `docker:` section with Docker settings. If this section is omitted, Docker containers will not be used. These settings can be included in project, user, or global configuration. Here is an annotated configuration file. The default values are shown unless otherwise noted. docker: # Set to false to disable using Docker. In the project configuration, # the presence of a `docker:` section implies docker is enabled unless # `enable: false` is set. In user and global configuration, this is not # the case. enable: true # The name of the repository to pull the image from. See the "repositories" # section of this document for more information about available repositories. # If this includes a tag (e.g. "my/image:tag"), that tagged image will be # used. Without a tag specified, the LTS version slug is added automatically. # Either `repo` or `image` may be specified, but not both. repo: "fpco/stack-build" # Exact Docker image name or ID. Overrides `repo`. Either `repo` or `image` # may be specified, but not both. (default none) image: "5c624ec1d63f" # Registry requires login. A login will be requested before attempting to # pull. registry-login: false # Username to log into the registry. (default none) registry-username: "myuser" # Password to log into the registry. (default none) registry-password: "SETME" # If true, the image will be pulled from the registry automatically, without # needing to run `stack docker pull`. See the "security" section of this # document for implications of enabling this. auto-pull: false # If true, the container will be run "detached" (in the background). Refer # to the Docker users guide for information about how to manage containers. # This option would rarely make sense in the configuration file, but can be # useful on the command-line. When true, implies `persist`.` detach: false # If true, the container will not be deleted after it terminates. Refer to # the Docker users guide for information about how to manage containers. This # option would rarely make sense in the configuration file, but can be # useful on the command-line. `detach` implies `persist`. persist: false # What to name the Docker container. Only useful with `detach` or # `persist` true. (default none) container-name: "example-name" # Additional arguments to pass to `docker run`. (default none) run-args: ["--net=bridge"] # Directories from the host to volume-mount into the container. If it # contains a `:`, the part before the `:` is the directory on the host and # the part after the `:` is where it should be mounted in the container. # (default none, aside from the project and stack root directories which are # always mounted) mount: - "/foo/bar" - "/baz:/tmp/quux" # Environment variables to set in the container. Environment variables # are not automatically inherited from the host, so if you need any specific # variables, use the '--docker-env` command-line argument version of this to # pass them in. (default none) env: - "FOO=BAR" - "BAR=BAZ QUUX" # Location of database used to track image usage, which `stack docker cleanup` # uses to determine which images should be kept. On shared systems, it may # be useful to override this in the global configuration file so that # all users share a single database. database-path: "~/.stack/docker.db" # Location of a Docker container-compatible 'stack' executable with the # matching version. This executable must be built on linux-x86_64 and # statically linked. # Valid values are: # host: use the host's executable. This is the default when the host's # executable is known to work (e.g., from official linux-x86_64 bindist) # download: download a compatible executable matching the host's version. # This is the default when the host's executable is not known to work # image: use the 'stack' executable baked into the image. The version # must match the host's version # /path/to/stack: path on the host's local filesystem stack-exe: host # If true (the default when using the local Docker Engine), run processes # in the Docker container as the same UID/GID as the host. The ensures # that files written by the container are owned by you on the host. # When the Docker Engine is remote (accessed by tcp), defaults to false. set-user: true # Require the version of the Docker client to be within the specified # Cabal-style version range (e.g., ">= 1.6.0 && < 1.9.0") require-docker-version: "any" Image Repositories ------------------------------------------------------------------------------- FP Complete provides the following public image repositories on Docker Hub: - [fpco/stack-build](https://registry.hub.docker.com/u/fpco/stack-build/) (the default) - GHC (patched), tools (stack, cabal-install, happy, alex, etc.), and system developer libraries required to build all Stackage packages. - [fpco/stack-ghcjs-build](https://registry.hub.docker.com/u/fpco/stack-ghcjs-build/) - Like `stack-build`, but adds GHCJS. - [fpco/stack-full](https://registry.hub.docker.com/u/fpco/stack-full/) - Includes all Stackage packages pre-installed in GHC's global package database. These images are over 10 GB! - [fpco/stack-ghcjs-full](https://registry.hub.docker.com/u/fpco/stack-ghcjs-full/) - Like `stack-full`, but adds GHCJS. - [fpco/stack-run](https://registry.hub.docker.com/u/fpco/stack-run/) - Runtime environment for binaries built with Stackage. Includes system shared libraries required by all Stackage packages. Does not necessarily include all data required for every use (e.g. has texlive-binaries for HaTeX, but does not include LaTeX fonts), as that would be prohibitively large. Based on [phusion/baseimage](https://registry.hub.docker.com/u/phusion/baseimage/). FP Complete also builds custom variants of these images for their clients. These images can also be used directly with `docker run` and provide a complete Haskell build environment. In addition, most Docker images that contain the basics for running GHC can be used with Stack's Docker integration. For example, the [official Haskell image repository](https://hub.docker.com/_/haskell/) works. See [Custom images](#custom-images) for more details. Prerequisites ------------------------------------------------------------------------------- ### Linux 64-bit Docker use requires machine (virtual or metal) running a Linux distribution [that Docker supports](https://docs.docker.com/installation/#installation), with a 64-bit kernel. If you do not already have one, we suggest Ubuntu 14.04 ("trusty") since this is what we test with. While Docker does support non-Linux operating systems through the `boot2docker` VM, there are issues with host volume mounting that prevent stack from being usable in this configuration. See [#194](https://github.com/commercialhaskell/stack/issues/194) for details and workarounds. ### Docker Install the latest version of Docker by following the [instructions for your operating system](http://docs.docker.com/installation/). The Docker client should be able to connect to the Docker daemon as a non-root user. For example (from [here](http://docs.docker.com/installation/ubuntulinux/#ubuntu-raring-1304-and-saucy-1310-64-bit)): # Add the connected user "${USER}" to the docker group. # Change the user name to match your preferred user. sudo gpasswd -a ${USER} docker # Restart the Docker daemon. sudo service docker restart You will now need to log out and log in again for the group addition to take effect. Note the above has security implications. See [security](#security) for more. Security ------------------------------------------------------------------------------- Having `docker` usable as a non-root user is always a security risk, and will allow root access to your system. It is also possible to craft a `stack.yaml` that will run arbitrary commands in an arbitrary docker container through that vector, thus a `stack.yaml` could cause stack to run arbitrary commands as root. While this is a risk, it is not really a greater risk than is posed by the docker permissions in the first place (for example, if you ever run an unknown shell script or executable, or ever compile an unknown Haskell package that uses Template Haskell, you are at equal risk). Nevertheless, there are [plans to close the stack.yaml loophole](https://github.com/commercialhaskell/stack/issues/260). One way to mitigate this risk is, instead of allowing `docker` to run as non-root, replace `docker` with a wrapper script that uses `sudo` to run the real Docker client as root. This way you will at least be prompted for your root password. As [@gregwebs](https://github.com/gregwebs) pointed out, put this script named `docker` in your PATH (and make sure you remove your user from the `docker` group as well, if you added it earlier): #!/bin/bash -e # The goal of this script is to maintain the security privileges of sudo # Without having to constantly type "sudo" exec sudo /usr/bin/docker "$@" Additional notes ------------------------------------------------------------------------------- ### Volume-mounts and ephemeral containers Since filesystem changes outside of the volume-mounted project directory are not persisted across runs, this means that if you `stack exec sudo apt-get install some-ubuntu-package`, that package will be installed but then the container it's installed in will disappear, thus causing it to have no effect. If you wish to make this kind of change permanent, see later instructions for how to create a [derivative Docker image](#derivative-image). Inside the container, your home directory is a special location that volume- mounted from within your project directory's `.stack-work` in such a way as that installed GHC/cabal packages are not shared between different Stackage snapshots. In addition, `~/.stack` is volume-mounted from the host. ### Network stack containers use the host's network stack within the container by default, meaning a process running in the container can connect to services running on the host, and a server process run within the container can be accessed from the host without needing to explicitly publish its port. To run the container with an isolated network, use `--docker-run-args` to pass the `--net` argument to `docker-run`. For example: stack --docker-run-args='--net=bridge --publish=3000:3000' \ exec some-server will run the container's network in "bridge" mode (which is Docker's default) and publish port 3000. ### Persistent container If you do want to do all your work, including editing, in the container, it might be better to use a persistent container in which you can install Ubuntu packages. You could get that by running something like `stack --docker-container-name=NAME --docker-persist exec --plain bash`. This means when the container exits, it won't be deleted. You can then restart it using `docker start -a -i NAME`. It's also possible to detach from a container while it continues running in the background using by pressing Ctrl-P Ctrl-Q, and then reattach to it using `docker attach NAME`. Note that each time you run `stack --docker-persist`, a _new_ persistent container is created (it will not automatically reuse the previous one). See the [Docker user guide](https://docs.docker.com/userguide/) for more information about managing Docker containers. ### Derivative image Creating your own custom derivative image can be useful if you need to install additional Ubuntu packages or make other changes to the operating system. Here is an example (replace `stack-build:custom` if you prefer a different name for your derived container, but it's best if the repo name matches what you're deriving from, only with a different tag, to avoid recompilation): ;;; On host $ sudo stack --docker-persist --docker-container-name=temp exec bash ;;; In container, make changes to OS # apt-get install r-cran-numderiv [...] # exit ;;; On host again $ docker commit temp stack-build:custom $ docker rm temp Now you have a new Docker image named `stack-build:custom`. To use the new image, run a command such as the following or update the corresponding values in your `stack.yaml`: stack --docker-image=stack-build:custom Note, however, that any time a new image is used, you will have to re-do this process. You could also use a Dockerfile to make this reusable. Consult the [Docker user guide](https://docs.docker.com/userguide/) for more on creating Docker images. ### Custom images The easiest way to create your own custom image us by extending FP Complete's images, but if you prefer to start from scratch, most images that include the basics for building code with GHC will work. The image doesn't even, strictly speaking, need to include GHC, but it does need to have libraries and tools that GHC requires (e.g., libgmp, gcc, etc.). There are also a few ways to set up images that tightens the integration: * Create a user and group named `stack`, and create a `~/.stack` directory for it. Any build plans and caches from it will be copied from the image by Stack, meaning they don't need to be downloaded separately. * Any packages in GHC's global package database will be available. This can be used to add private libraries to the image, or the make available a set of packages from an LTS release. Troubleshooting ------------------------------------------------------------------------------- ### "No Space Left on Device", but 'df' shows plenty of disk space This is likely due to the storage driver Docker is using, in combination with the large size and number of files in these images. Use `docker info|grep 'Storage Driver'` to determine the current storage driver. We recommend using either the `overlay` or `aufs` storage driver for stack, as they are least likely to give you trouble. On Ubuntu, `aufs` is the default for new installations, but older installations sometimes used `devicemapper`. The `devicemapper` storage driver's default configuration limits it to a 10 GB file system, which the "full" images exceed. We have experienced other instabilities with it as well on Ubuntu, and recommend against its use for this purpose. The `btrfs` storage driver has problems running out of metadata space long before running out of actual disk space, which requires rebalancing or adding more metadata space. See [CoreOS's btrfs troubleshooting page](https://coreos.com/docs/cluster-management/debugging/btrfs-troubleshooting/) for details about how to do this. Pass the `-s ` argument to the Docker daemon to set the storage driver (in `/etc/default/docker` on Ubuntu). See [Docker daemon storage-driver option](https://docs.docker.com/reference/commandline/cli/#daemon-storage-driver-option) for more details. You may also be running out of inodes on your filesystem. Use `df -i` to check for this condition. Unfortunately, the number of inodes is set when creating the filesystem, so fixing this requires reformatting and passing the `-N` argument to mkfs.ext4. ### Name resolution doesn't work from within container On Ubuntu 12.04, by default `NetworkManager` runs `dnsmasq` service, which sets `127.0.0.1` as your DNS server. Since Docker containers cannot access this dnsmasq, Docker falls back to using Google DNS (8.8.8.8/8.8.4.4). This causes problems if you are forced to use internal DNS server. This can be fixed by executing: sudo sed 's@dns=dnsmasq@#dns=dnsmasq@' -i \ /etc/NetworkManager/NetworkManager.conf && \ sudo service network-manager restart If you have already installed Docker, you must restart the daemon for this change to take effect: sudo service docker restart The above commands turn off `dnsmasq` usage in NetworkManager configuration and restart network manager. They can be reversed by executing `sudo sed 's@#dns=dnsmasq@dns=dnsmasq@' -i /etc/NetworkManager/NetworkManager.conf && sudo service network-manager restart`. These instructions are adapted from [the Shipyard Project's QuickStart guide](https://github.com/shipyard/shipyard/wiki/QuickStart#127011-dns-server-problem-on-ubuntu). ### Cannot pull images from behind firewall that blocks TLS/SSL If you are behind a firewall that blocks TLS/SSL and pulling images from a private Docker registry, you must edit the system configuration so that the `--insecure-registry ` option is passed to the Docker daemon. For example, on Ubuntu: echo 'DOCKER_OPTS="--insecure-registry registry.example.com"' \ |sudo tee -a /etc/default/docker sudo service docker restart This does require the private registry to be available over plaintext HTTP. See [Docker daemon insecure registries documentation](https://docs.docker.com/reference/commandline/cli/#insecure-registries) for details. stack-1.1.2/doc/faq.md0000644000000000000000000004450012717707440012660 0ustar0000000000000000# FAQ So that this doesn't become repetitive: for the reasons behind the answers below, see the [Architecture](architecture.md) page. The goal of the answers here is to be as helpful and concise as possible. ## Where is stack installed and will it interfere with `ghc` (etc) I already have installed? Stack itself is installed in normal system locations based on the mechanism you used (see the [Install and upgrade](install_and_upgrade.md) page). Stack installs the Stackage libraries in `~/.stack` and any project libraries or extra dependencies in a `.stack-work` directory within each project's directory. None of this should affect any existing Haskell tools at all. ## What is the relationship between stack and cabal? * Cabal-the-library is used by stack to build your Haskell code. * cabal-install (the executable) is used by stack for its dependency solver functionality. * A .cabal file is provided for each package, and defines all package-level metadata just like it does in the cabal-install world: modules, executables, test suites, etc. No change at all on this front. * A stack.yaml file references 1 or more packages, and provides information on where dependencies come from. * `stack build` currently initializes a stack.yaml from the existing .cabal file. Project initialization is something that is still being discussed and there may be more options here for new projects in the future (see issue [253](https://github.com/commercialhaskell/stack/issues/253)) ## I need to use a different version of a package than what is provided by the LTS Haskell snapshot I'm using, what should I do? You can make tweaks to a snapshot by modifying the `extra-deps` configuration value in your `stack.yaml` file, e.g.: ```yaml resolver: lts-2.9 packages: - '.' extra-deps: - text-1.2.1.1 ``` ## I need to use a package (or version of a package) that is not available on hackage, what should I do? Add it to the `packages` list in your project's `stack.yaml`, specifying the package's source code location relative to the directory where your `stack.yaml` file lives, e.g. ```yaml resolver: lts-2.10 packages: - '.' - third-party/proprietary-dep - github-version-of/conduit - patched/diagrams extra-deps: [] ``` The above example specifies that it should include the package at the root directory (`'.'`), that the `proprietary-dep` package is found in the project's `third-party` folder, that the `conduit` package is found in the project's `github-version-of` folder, and that the `diagrams` package is found in the project's `patched` folder. This autodetects changes and reinstalls the package. To install packages directly from a Git repository, use e.g.: ```yaml resolver: lts-2.10 packages: - location: git: https://github.com/githubuser/reponame.git commit: somecommitID ``` Note that the `- '.'` line has been omitted, so the package in the root directory will not be used. ## What is the meaning of the arguments given to stack build, test, etc? Those are the targets of the build, and can have one of three formats: * A package name (e.g., `my-package`) will mean that the `my-package` package must be built * A package identifier (e.g., `my-package-1.2.3`), which includes a specific version. This is useful for passing to `stack install` for getting a specific version from upstream * A directory (e.g., `./my-package`) for including a local directory's package, including any packages in subdirectories ## I need to modify an upstream package, how should I do it? Typically, you will want to get the source for the package and then add it to your `packages` list in stack.yaml. (See the previous question.) `stack unpack` is one approach for getting the source. Another would be to add the upstream package as a submodule to your project. ## Am I required to use a Stackage snapshot to use stack? No, not at all. If you prefer dependency solving to curation, you can continue with that workflow. Instead of describing the details of how that works here, it's probably easiest to just say: run `stack init --solver` and look at the generated stack.yaml. ## How do I use this with sandboxes? Explicit sandboxing on the part of the user is not required by stack. All builds are automatically isolated into separate package databases without any user interaction. This ensures that you won't accidentally corrupt your installed packages with actions taken in other projects. ## Can I run `cabal` commands inside `stack exec`? With a recent enough version of cabal-install (>= 1.22), you can. For older versions, due to [haskell/cabal#1800](https://github.com/haskell/cabal/issues/1800), this does not work. Note that even with recent versions, for some commands you may need this extra level of indirection: ``` $ stack exec -- cabal exec -- cabal ``` However, virtually all `cabal` commands have an equivalent in stack, so this should not be necessary. In particular, `cabal` users may be accustomed to the `cabal run` command. In stack: ``` $ stack build && stack exec ``` Or, if you want to install the binaries in a shared location: ``` $ stack install $ ``` assuming your `$PATH` has been set appropriately. ## Using custom preprocessors If you have a custom preprocessor, for example, Ruby, you may have a file like: ***B.erb*** ``` haskell module B where <% (1..5).each do |i| %> test<%= i %> :: Int test<%= i %> = <%= i %> <% end %> ``` To ensure that Stack picks up changes to this file for rebuilds, add the following line to your .cabal file: extra-source-files: B.erb ## I already have GHC installed, can I still use stack? Yes. stack will default to using whatever GHC is on your `PATH`. If that GHC is a compatible version with the snapshot you're using, it will simply use it. Otherwise, it will prompt you to run `stack setup`. Note that `stack setup` installs GHC into `~/.stack/programs/$platform/ghc-$version/` and not a global location. Note that GHC installation doesn't work for all OSes, so in some cases the first option will need to install GHC yourself. ## How does stack determine what GHC to use? It uses the first GHC that it finds on the `PATH`. If that GHC does not comply with the various requirements (version, architecture) that your project needs, it will prompt you to run `stack setup` to get it. `stack` is fully aware of all GHCs that it has installed itself. See [this issue](https://github.com/commercialhaskell/stack/issues/420) for a detailed discussion. ## How do I upgrade to GHC 7.10.2 with stack? If you already have a prior version of GHC use `stack --resolver ghc-7.10 setup --reinstall`. If you don't have any GHC installed, you can skip the `--reinstall`. ## How do I get extra build tools? stack will automatically install build tools required by your packages or their dependencies, in particular alex and happy. __NOTE__: This works when using lts or nightly resolvers, not with ghc or custom resolvers. You can manually install build tools by running, e.g., `stack build alex happy`. ## How does stack choose which snapshot to use when creating a new config file? It checks the two most recent LTS Haskell major versions and the most recent Stackage Nightly for a snapshot that is compatible with all of the version bounds in your .cabal file, favoring the most recent LTS. For more information, see the snapshot auto-detection section in the architecture document. ## I'd like to use my installed packages in a different directory. How do I tell stack where to find my packages? Set the `STACK_YAML` environment variable to point to the `stack.yaml` config file for your project. Then you can run `stack exec`, `stack ghc`, etc., from any directory and still use your packages. ## My tests are failing. What should I do? Like all other targets, `stack test` runs test suites in parallel by default. This can cause problems with test suites that depend on global resources such as a database or binding to a fixed port number. A quick hack is to force stack to run all test suites in sequence, using `stack test --jobs=1`. For test suites to run in parallel developers should ensure that their test suites do not depend on global resources (e.g. by asking the OS for a random port to bind to) and where unavoidable, add a lock in order to serialize access to shared resources. ## Can I get bash autocompletion? Yes, see the [shell-autocompletion documentation](shell_autocompletion.md) ## How do I update my package index? Users of cabal are used to running `cabal update` regularly. You can do the same with stack by running `stack update`. But generally, it's not necessary: if the package index is missing, or if a snapshot refers to package/version that isn't available, stack will automatically update and then try again. If you run into a situation where stack doesn't automatically do the update for you, please report it as a bug. ## Isn't it dangerous to automatically update the index? Can't that corrupt build plans? No, stack is very explicit about which packages it's going to build for you. There are three sources of information to tell it which packages to install: the selected snapshot, the `extra-deps` configuration value, and your local packages. The only way to get stack to change its build plan is to modify one of those three. Updating the index will have no impact on stack's behavior. ## I have a custom package index I'd like to use, how do I do so? You can configure this in your stack.yaml. See [YAML configuration](yaml_configuration.md). ## How can I make sure my project builds against multiple ghc versions? You can create multiple yaml files for your project, one for each build plan. For example, you might set up your project directory like so: ``` myproject/ stack-7.8.yaml stack-7.10.yaml stack.yaml --> symlink to stack-7.8.yaml myproject.cabal src/ ... ``` When you run `stack build`, you can set the `STACK_YAML` environment variable to indicate which build plan to use. ``` $ stack build # builds using the default stack.yaml $ STACK_YAML=stack-7.10.yaml stack build # builds using the given yaml file ``` ## I heard you can use this with Docker? Yes, stack supports using Docker with images that contain preinstalled Stackage packages and the tools. See [Docker integration](docker_integration.md) for details. ## How do I use this with Travis CI? See the [Travis section in the GUIDE](GUIDE.md#travis-with-caching) ## What is licensing restrictions on Windows? Currently on Windows GHC produces binaries linked statically with [GNU Multiple Precision Arithmetic Library](https://gmplib.org/) (GMP), which is used by [integer-gmp](https://hackage.haskell.org/package/integer-gmp) library to provide big integer implementation for Haskell. Contrary to the majority of Haskell code licensed under permissive BSD3 license, GMP library is licensed under LGPL, which means resulting binaries [have to be provided with source code or object files](http://www.gnu.org/licenses/gpl-faq.html#LGPLStaticVsDynamic). That may or may not be acceptable for your situation. Current workaround is to use GHC built with alternative big integer implementation called integer-simple, which is free from LGPL limitations as it's pure Haskell and does not use GMP. Unfortunately it has yet to be available out of the box with stack. See [issue #399](https://github.com/commercialhaskell/stack/issues/399) for the ongoing effort and information on workarounds. ## How to get a working executable on Windows? When executing a binary after building with `stack build` (e.g. for target "foo"), the command `foo.exe` might complain about missing runtime libraries (whereas `stack exec foo` works). Windows is not able to find the necessary C++ libraries from the standard prompt because they're not in the PATH environment variable. `stack exec` works because it's modifying PATH to include extra things. Those libraries are shipped with GHC (and, theoretically in some cases, MSYS). The easiest way to find them is `stack exec which`. E.g. >stack exec which libstdc++-6.dll /c/Users/Michael/AppData/Local/Programs/stack/i386-windows/ghc-7.8.4/mingw/bin/libstdc++-6.dll A quick workaround is adding this path to the PATH environment variable or copying the files somewhere Windows finds them (cf. https://msdn.microsoft.com/de-de/library/7d83bc18.aspx). Cf. issue [#425](https://github.com/commercialhaskell/stack/issues/425). ## Can I change stack's default temporary directory? Stack makes use of a temporary directory for some commands (/tmp by default on linux). If there is not enough free space in this directory, stack may fail (see issue [#429](https://github.com/commercialhaskell/stack/issues/429) ). For instance `stack setup` with a GHC installation requires roughly 1GB free. A custom temporary directory can be forced: * on Linux by setting the environment variable TMPDIR (eg `$ TMPDIR=path-to-tmp stack setup`) * on Windows by setting one of the environment variable (given in priority order), TMP, TEMP, USERPROFILE If you use Stack with Nix integration, be aware that Nix _also_ uses that TMPDIR variable, and if it is not set Nix sets it to some subdirectory of `/run`, which on most Linuxes is a Ramdir. Nix will run the builds in TMPDIR, therefore if you don't have enough RAM you will get errors about disk space. If this happens to you, please _manually_ set TMPDIR before launching Stack to some directory on the disk. ## stack sometimes rebuilds based on flag changes when I wouldn't expect it to. How come? stack tries to give you reproducibility whenever possible. In some cases, this means that you get a recompile when one may not seem necessary. The most common example is running something like this in a multi-package project: stack build --ghc-options -O0 && stack build --ghc-options -O0 one-of-the-packages This may end up recompiling local dependencies of `one-of-the-packages` without optimizations on. Whether stack should or shouldn't do this depends on the needs of the user at the time, and unfortunately we can't make a solution that will make everyone happy in all cases. If you're curious for details, there's [a long discussion about it](https://github.com/commercialhaskell/stack/issues/382) on the issue tracker. ## stack setup on a windows system only tells me to add certain paths to the PATH variable instead of doing it If you are using a powershell session, it is easy to automate even that step: $env:Path = ( stack setup | %{ $_ -replace '[^ ]+ ', ''} ), $env:Path -join ";" ## How do I reset / remove Stack (such as to to do a completely fresh build)? The first thing to remove is project-specific `.stack-work` directory within the project's directory. Next, remove `~/.stack` directory overall. You may have errors if you remove the latter but leave the former. Removing Stack itself will relate to how it was installed, and if you used GHC installed outside of Stack, that would need to be removed separately. ## How does stack handle parallel builds? What exactly does it run in parallel? See [issue #644](https://github.com/commercialhaskell/stack/issues/644) for more details. ## I get strange `ld` errors about recompiling with "-fPIC" Some users (myself included!) have come across a linker errors (example below) that seem to be dependent on the local environment, i.e. the package may compile on a different machine. There is no known workaround (if you come across one please include details), however the issue has been reported to be [non-deterministic](https://github.com/commercialhaskell/stack/issues/614) in some cases. I've had success using the docker functionality to build the project on a machine that would not compile it otherwise. ``` tmp-0.1.0.0: build Building tmp-0.1.0.0... Preprocessing executable 'tmp' for tmp-0.1.0.0... Linking dist-stack/x86_64-linux/Cabal-1.22.2.0/build/tmp/tmp ... /usr/bin/ld: dist-stack/x86_64-linux/Cabal-1.22.2.0/build/tmp/tmp-tmp/Main.o: relocation R_X86_64_32S against `stg_bh_upd_frame_info' can not be used when making a shared object; recompile with -fPIC dist-stack/x86_64-linux/Cabal-1.22.2.0/build/tmp/tmp-tmp/Main.o: error adding symbols: Bad value collect2: error: ld returned 1 exit status -- While building package tmp-0.1.0.0 using: /home/philip/.stack/programs/x86_64-linux/ghc-7.10.1/bin/runghc-7.10.1 -package=Cabal-1.22.2.0 -clear-package-db -global-package-db /home/philip/tmp/Setup.hs --builddir=dist-stack/x86_64-linux/Cabal-1.22.2.0/ build Process exited with code: ExitFailure 1 ``` ## Where does the output from `--ghc-options=-ddump-splices` (and other `-ddump*` options) go? These are written to `*.dump-*` files inside the package's `.stack-work` directory. ## Why is DYLD_LIBRARY_PATH ignored? If you are on Mac OS X 10.11 ("El Capitan") or later, there is an [upstream GHC issue](https://ghc.haskell.org/trac/ghc/ticket/11617) which [prevents the `DYLD_LIBRARY_PATH` environment variable from being passed to GHC](https://github.com/commercialhaskell/stack/issues/1161) when System Integrity Protection (a.k.a. "rootless") is enabled. There are two known workarounds: 1. Known to work in all cases: [disable System Integrity Protection](http://osxdaily.com/2015/10/05/disable-rootless-system-integrity-protection-mac-os-x/). **WARNING: Disabling SIP will severely reduce the security of your system, so only do this if absolutely necessary!** 2. Experimental: [modify GHC's shell script wrappers to use a shell outside the protected directories](https://github.com/commercialhaskell/stack/issues/1161#issuecomment-186690904). ## Why do I get a `/usr/bin/ar: permission denied` error? If you are on OS X 10.11 ("El Capitan") or later, GHC 7.8.4 is [incompatible with System Integrity Protection (a.k.a. "rootless")](https://github.com/commercialhaskell/stack/issues/563). GHC 7.10.2 includes a fix, so this only affects users of GHC 7.8.4. If you cannot upgrade to GHC 7.10.2, you can work around it by [disabling System Integrity Protection](http://osxdaily.com/2015/10/05/disable-rootless-system-integrity-protection-mac-os-x/). **WARNING: Disabling SIP will severely reduce the security of your system, so only do this if absolutely necessary!** ## Why is the `--` argument separator ignored in Windows PowerShell Some versions of Windows PowerShell [don't pass the `--` to programs](https://github.com/commercialhaskell/stack/issues/813). The workaround is to quote the `"--"`, e.g.: stack exec "--" cabal --version This is known to be a problem on Windows 7, but seems to be fixed on Windows 10. stack-1.1.2/doc/ghcjs.md0000644000000000000000000000672112706265473013215 0ustar0000000000000000# GHCJS To use GHCJS with stack `>= 0.1.8`, place a GHCJS version in the [`compiler`](yaml_configuration.md#compiler) field of `stack.yaml`. After this, all stack commands should work with GHCJS, except for `ide`. In particular: * `stack setup` will install GHCJS from source and boot it, which takes a long time. * `stack build` will compile your code to JavaScript. In particular, the generated code for an executable ends up in `$(stack path --local-install-root)/bin/EXECUTABLE.jsexe/all.js` (bash syntax, where `EXECUTABLE` is the name of your executable). You can also build existing stack projects which target GHC, and instead build them with GHCJS. For example: `stack build --compiler ghcjs-0.1.0.20150924_ghc-7.10.2` Sidenote: If you receive a message like `The program 'ghcjs' version >=0.1 is required but the version of .../ghcjs could not be determined.`, then you may need to install a different version of `node`. See [stack issue #1496](https://github.com/commercialhaskell/stack/issues/1496). ## Example Configurations ### GHCJS `master` (a.k.a. improved base) To use the master branch, a.k.a improved base, add the following to your `stack.yaml`: GHCJS compiled with GHC 7.10.3 LTS-5.12 (stack.yaml upgraded from stock GHCJS) ```yaml compiler: ghcjs-0.2.0.20160414_ghc-7.10.3 compiler-check: match-exact setup-info: ghcjs: source: ghcjs-0.2.0.20160414_ghc-7.10.3: url: https://s3.amazonaws.com/ghcjs/ghcjs-0.2.0.20160414_ghc-7.10.3.tar.gz sha1: 6d6f307503be9e94e0c96ef1308c7cf224d06be3 ``` GHCJS compiled with GHC 7.10.2 LTS-3.6 (stack.yaml that comes with GHCJS) ```yaml compiler: ghcjs-0.2.0.20160414_ghc-7.10.2 compiler-check: match-exact setup-info: ghcjs: source: ghcjs-0.2.0.20160414_ghc-7.10.2: url: https://s3.amazonaws.com/ghcjs/ghcjs-0.2.0.20160414_ghc-7.10.2.tar.gz sha1: f0a7243e781e27ebfe601eebaf5c57422007c142 ``` ### GHCJS (old base) You can use this resolver for GHCJS (old base) in your `stack.yaml`: ```yaml compiler: ghcjs-0.1.0.20150924_ghc-7.10.2 compiler-check: match-exact ``` ### Custom installed GHCJS (development branch) In order to use a GHCJS installed on your path, just add the following to your `stack.yaml`: ```yaml compiler: ghcjs-0.2.0_ghc-7.10.2 ``` (Or, `ghcjs-0.1.0_ghc-7.10.2` if you are working with an older version) ## Project with both client and server For projects with both a server and client, the recommended project organization is to put one or both of your `stack.yaml` files in sub-directories. This way, you can use the current working directory to specify whether you're working on the client or server. This will also allow more straightforward editor tooling, once projects like `ghc-mod` and `haskell-ide-engine` support GHCJS. For example, here's what a script for building both client and server looks like: ```bash #!/bin/bash # Build the client stack build --stack-yaml=client/stack.yaml # Copy over the javascript rm -f server/static/all.js cp $(stack path --stack-yaml=client/stack.yaml --local-install-root)/bin/client.jsexe/all.js server/static/all.js # Build the server stack build --stack-yaml=server/stack.yaml ``` You can also put both the yaml files in the same directory, and have e.g. `ghcjs-stack.yaml`, but this won't work well with editor integrations. ## Using stack without a snapshot If you don't want to use a snapshot, instead place the ghcjs version in the `resolver` field of your `stack.yaml`. This is also necessary when using stack `< 0.1.8`. stack-1.1.2/doc/GUIDE.md0000644000000000000000000025467612717707440012767 0ustar0000000000000000# User guide stack is a modern, cross-platform build tool for Haskell code. This guide takes a new stack user through the typical workflows. This guide will not teach Haskell or involve much code, and it requires no prior experience with the Haskell packaging system or other build tools. ## Stack's functions stack handles the management of your toolchain (including GHC — the Glasgow Haskell Compiler — and, for Windows users, MSYS), building and registering libraries, building build tool dependencies, and more. While it can use existing tools on your system, stack has the capacity to be your one-stop shop for all Haskell tooling you need. This guide will follow that stack-centric approach. ### What makes stack special? The primary stack design point is __reproducible builds__. If you run `stack build` today, you should get the same result running `stack build` tomorrow. There are some cases that can break that rule (changes in your operating system configuration, for example), but, overall, stack follows this design philosophy closely. To make this a simple process, stack uses curated package sets called __snapshots__. stack has also been designed from the ground up to be user friendly, with an intuitive, discoverable command line interface. For many users, simply downloading stack and reading `stack --help` will be enough to get up and running. This guide provides a more gradual tour for users who prefer that learning style. To build your project, stack uses a `stack.yaml` file in the root directory of your project as a sort of blueprint. That file contains a reference, called a __resolver__, to the snapshot which your package will be built against. Finally, stack is __isolated__: it will not make changes outside of specific stack directories. stack-built files generally go in either the stack root directory (default `~/.stack`) or `./.stack-work` directories local to each project. The stack root directory holds packages belonging to snapshots and any stack-installed versions of GHC. Stack will not tamper with any system version of GHC or interfere with packages installed by `cabal` or any other build tools. _NOTE_ In this guide, we'll use commands as run on a GNU/Linux system (specifically Ubuntu 14.04, 64-bit) and share output from that. Output on other systems — or with different versions of stack — will be slightly different, but all commands work cross-platform, unless explicitly stated otherwise. ## Downloading and Installation The [documentation dedicated to downloading stack](install_and_upgrade.md) has the most up-to-date information for a variety of operating systems, including multiple GNU/Linux flavors. Instead of repeating that content here, please go check out that page and come back here when you can successfully run `stack --version`. The rest of this session will demonstrate the installation procedure on a vanilla Ubuntu 14.04 machine. ``` # Starting with a *really* bare machine michael@d30748af6d3d:~$ sudo apt-get install wget # Demonstrate that stack really isn't available michael@d30748af6d3d:~$ stack -bash: stack: command not found # Get the signing key for the package repo michael@d30748af6d3d:~$ wget -q -O- https://s3.amazonaws.com/download.fpcomplete.com/ubuntu/fpco.key | sudo apt-key add - OK michael@d30748af6d3d:~$ echo 'deb http://download.fpcomplete.com/ubuntu/trusty stable main'|sudo tee /etc/apt/sources.list.d/fpco.list deb http://download.fpcomplete.com/ubuntu/trusty stable main michael@d30748af6d3d:~$ sudo apt-get update && sudo apt-get install stack -y # downloading... michael@d30748af6d3d:~$ stack --version Version 0.1.3.1, Git revision 908b04205e6f436d4a5f420b1c6c646ed2b804d7 ``` With stack now up and running, you're good to go. Though not required, we recommend setting your PATH environment variable to include `$HOME/.local/bin`: ``` michael@d30748af6d3d:~$ echo 'export PATH=$HOME/.local/bin:$PATH' >> ~/.bashrc ``` ## Hello World Example With stack installed, let's create a new project from a template and walk through the most common stack commands. ### stack new We'll start off with the `stack new` command to create a new *project*, that will contain a Haskell *package* of the same name. So let's pick a valid package name first: > A package is identified by a globally-unique package name, which consists of one or more alphanumeric words separated by hyphens. To avoid ambiguity, each of these words should contain at least one letter. (From the [Cabal users guide](https://www.haskell.org/cabal/users-guide/developing-packages.html#developing-packages)) We'll call our project `helloworld`, and we'll use the `new-template` project template: ``` michael@d30748af6d3d:~$ stack new helloworld new-template ``` For this first stack command, there's quite a bit of initial setup it needs to do (such as downloading the list of packages available upstream), so you'll see a lot of output. Though your exact results may vary, below is an example of the sort of output you will see. Over the course of this guide a lot of the content will begin to make more sense: ``` Downloading template "new-template" to create project "helloworld" in helloworld/ ... Using the following authorship configuration: author-email: example@example.com author-name: Example Author Name Copy these to /home/michael/.stack/config.yaml and edit to use different values. Writing default config file to: /home/michael/helloworld/stack.yaml Basing on cabal files: - /home/michael/helloworld/helloworld.cabal Downloaded lts-3.2 build plan. Caching build plan Fetched package index. Populated index cache. Checking against build plan lts-3.2 Selected resolver: lts-3.2 Wrote project config to: /home/michael/helloworld/stack.yaml ``` We now have a project in the `helloworld` directory! ### stack setup Instead of assuming you want stack to download and install GHC for you, it asks you to do this as a separate command: `setup`. If we don't run `stack setup` now, we'll later see a message that we are missing the right GHC version. Let's run stack setup: ``` michael@d30748af6d3d:~/helloworld$ stack setup Downloaded ghc-7.10.2. Installed GHC. stack will use a locally installed GHC For more information on paths, see 'stack path' and 'stack exec env' To use this GHC and packages outside of a project, consider using: stack ghc, stack ghci, stack runghc, or stack exec ``` It doesn't come through in the output here, but you'll get intermediate download percentage statistics while the download is occurring. This command may take some time, depending on download speeds. __NOTE__: GHC will be installed to your global stack root directory, so calling `ghc` on the command line won't work. See the `stack exec`, `stack ghc`, and `stack runghc` commands below for more information. ### stack build Next, we'll run the most important stack command: `stack build`. __NOTE__: If you forgot to run `stack setup` in the previous step you'll get an error: ``` michael@d30748af6d3d:~$ cd helloworld/ michael@d30748af6d3d:~/helloworld$ stack build No GHC found, expected version 7.10.2 (x86_64) (based on resolver setting in /home/michael/helloworld/stack.yaml). Try running stack setup ``` stack needs GHC in order to build your project, and `stack setup` must be run to check whether GHC is available (and install it if not). Having run `stack setup` successfully, `stack build` should build our project: ``` michael@d30748af6d3d:~/helloworld$ stack build helloworld-0.1.0.0: configure Configuring helloworld-0.1.0.0... helloworld-0.1.0.0: build Preprocessing library helloworld-0.1.0.0... [1 of 1] Compiling Lib ( src/Lib.hs, .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/Lib.o ) In-place registering helloworld-0.1.0.0... Preprocessing executable 'helloworld-exe' for helloworld-0.1.0.0... [1 of 1] Compiling Main ( app/Main.hs, .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/helloworld-exe/helloworld-exe-tmp/Main.o ) Linking .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/helloworld-exe/helloworld-exe ... helloworld-0.1.0.0: install Installing library in /home/michael/helloworld/.stack-work/install/x86_64-linux/lts-3.2/7.10.2/lib/x86_64-linux-ghc-7.10.2/helloworld-0.1.0.0-6urpPe0MO7OHasGCFSyIAT Installing executable(s) in /home/michael/helloworld/.stack-work/install/x86_64-linux/lts-3.2/7.10.2/bin Registering helloworld-0.1.0.0... ``` ### stack exec Looking closely at the output of the previous command, you can see that it built both a library called "helloworld" and an executable called "helloworld-exe". We'll explain more in the next section, but, for now, just notice that the executables are installed in our project's `./stack-work` directory. Now, Let's use `stack exec` to run our executable (which just outputs the string "someFunc"): ``` michael@d30748af6d3d:~/helloworld$ stack exec helloworld-exe someFunc ``` `stack exec` works by providing the same reproducible environment that was used to build your project to the command that you are running. Thus, it knew where to find `helloworld-exe` even though it is hidden in the `./stack-work` directory. ### stack test Finally, like all good software, helloworld actually has a test suite. Let's run it with `stack test`: ``` michael@d30748af6d3d:~/helloworld$ stack test NOTE: the test command is functionally equivalent to 'build --test' helloworld-0.1.0.0: configure (test) Configuring helloworld-0.1.0.0... helloworld-0.1.0.0: build (test) Preprocessing library helloworld-0.1.0.0... In-place registering helloworld-0.1.0.0... Preprocessing test suite 'helloworld-test' for helloworld-0.1.0.0... [1 of 1] Compiling Main ( test/Spec.hs, .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/helloworld-test/helloworld-test-tmp/Main.o ) Linking .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/helloworld-test/helloworld-test ... helloworld-0.1.0.0: test (suite: helloworld-test) Test suite not yet implemented ``` Reading the output, you'll see that stack first builds the test suite and then automatically runs it for us. For both the `build` and `test` command, already built components are not built again. You can see this by running `stack build` and `stack test` a second time: ``` michael@d30748af6d3d:~/helloworld$ stack build michael@d30748af6d3d:~/helloworld$ stack test NOTE: the test command is functionally equivalent to 'build --test' helloworld-0.1.0.0: test (suite: helloworld-test) Test suite not yet implemented ``` ## Inner Workings of stack In this subsection, we'll dissect the helloworld example in more detail. ### Files in helloworld Before studying stack more, let's understand our project a bit better. ``` michael@d30748af6d3d:~/helloworld$ find * -type f LICENSE Setup.hs app/Main.hs helloworld.cabal src/Lib.hs stack.yaml test/Spec.hs ``` The `app/Main.hs`, `src/Lib.hs`, and `test/Spec.hs` files are all Haskell source files that compose the actual functionality of our project (we won't dwell on them here). The LICENSE file has no impact on the build, but is there for informational/legal purposes only. The files of interest here are Setup.hs, helloworld.cabal, and stack.yaml. The Setup.hs file is a component of the Cabal build system which stack uses. It's technically not needed by stack, but it is still considered good practice in the Haskell world to include it. The file we're using is straight boilerplate: ```haskell import Distribution.Simple main = defaultMain ``` Next, let's look at our stack.yaml file, which gives our project-level settings: ```yaml flags: {} packages: - '.' extra-deps: [] resolver: lts-3.2 ``` If you're familiar with YAML, you may recognize that the `flags` and `extra-deps` keys have empty values. We'll see more interesting usages for these fields later. Let's focus on the other two fields. `packages` tells stack which local packages to build. In our simple example, we have only a single package in our project, located in the same directory, so `'.'` suffices. However, stack has powerful support for multi-package projects, which we'll elaborate on as this guide progresses. The final field is resolver. This tells stack *how* to build your package: which GHC version to use, versions of package dependencies, and so on. Our value here says to use [LTS Haskell version 3.2](https://www.stackage.org/lts-3.2), which implies GHC 7.10.2 (which is why `stack setup` installs that version of GHC). There are a number of values you can use for resolver, which we'll cover later. The final file of import is helloworld.cabal. stack is built on top of the Cabal build system. In Cabal, we have individual *packages*, each of which contains a single .cabal file. The .cabal file can define 1 or more *components*: a library, executables, test suites, and benchmarks. It also specifies additional information such as library dependencies, default language pragmas, and so on. In this guide, we'll discuss the bare minimum necessary to understand how to modify a .cabal file. Haskell.org has the definitive [reference for the .cabal file format](https://www.haskell.org/cabal/users-guide/developing-packages.html). ### The setup command As we saw above, the `setup` command installed GHC for us. Just for kicks, let's run `setup` a second time: ``` michael@d30748af6d3d:~/helloworld$ stack setup stack will use a locally installed GHC For more information on paths, see 'stack path' and 'stack exec env' To use this GHC and packages outside of a project, consider using: stack ghc, stack ghci, stack runghc, or stack exec ``` Thankfully, the command is smart enough to know not to perform an installation twice. `setup` will either use the first GHC it finds on your PATH, or a locally installed version. As the command output above indicates, you can use `stack path` for quite a bit of path information (which we'll play with more later). For now, we'll just look at where GHC is installed: ``` michael@d30748af6d3d:~/helloworld$ stack exec which ghc /home/michael/.stack/programs/x86_64-linux/ghc-7.10.2/bin/ghc ``` As you can see from that path (and as emphasized earlier), the installation is placed to not interfere with any other GHC installation, whether system-wide or even different GHC versions installed by stack. ### The build command The build command is the heart and soul of stack. It is the engine that powers building your code, testing it, getting dependencies, and more. Quite a bit of the remainder of this guide will cover more advanced `build` functions and features, such as building test and Haddocks at the same time, or constantly rebuilding blocking on file changes. *On a philosophical note:* Running the build command twice with the same options and arguments should generally be a no-op (besides things like rerunning test suites), and should, in general, produce a reproducible result between different runs. ## Adding dependencies Let's say we decide to modify our helloworld source a bit to use a new library, perhaps the ubiquitous text package. For example: ```haskell {-# LANGUAGE OverloadedStrings #-} module Lib ( someFunc ) where import qualified Data.Text.IO as T someFunc :: IO () someFunc = T.putStrLn "someFunc" ``` When we try to build this, things don't go as expected: ```haskell michael@d30748af6d3d:~/helloworld$ stack build helloworld-0.1.0.0-c91e853ce4bfbf6d394f54b135573db8: unregistering (local file changes) helloworld-0.1.0.0: configure Configuring helloworld-0.1.0.0... helloworld-0.1.0.0: build Preprocessing library helloworld-0.1.0.0... /home/michael/helloworld/src/Lib.hs:6:18: Could not find module `Data.Text.IO' Use -v to see a list of the files searched for. -- While building package helloworld-0.1.0.0 using: /home/michael/.stack/programs/x86_64-linux/ghc-7.10.2/bin/runhaskell -package=Cabal-1.22.4.0 -clear-package-db -global-package-db -package-db=/home/michael/.stack/snapshots/x86_64-linux/lts-3.2/7.10.2/pkgdb/ /tmp/stack5846/Setup.hs --builddir=.stack-work/dist/x86_64-linux/Cabal-1.22.4.0/ build exe:helloworld-exe --ghc-options -hpcdir .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/hpc/.hpc/ -ddump-hi -ddump-to-file Process exited with code: ExitFailure 1 ``` Notice that it says "Could not find module." This means that the package containing the module in question is not available. To tell stack to use text, you need to add it to your .cabal file — specifically in your build-depends section, like this: ``` library hs-source-dirs: src exposed-modules: Lib build-depends: base >= 4.7 && < 5 -- This next line is the new one , text default-language: Haskell2010 ``` Now if we rerun `stack build`, we should get a successful result: ``` michael@d30748af6d3d:~/helloworld$ stack build text-1.2.1.3: download text-1.2.1.3: configure text-1.2.1.3: build text-1.2.1.3: install helloworld-0.1.0.0: configure Configuring helloworld-0.1.0.0... helloworld-0.1.0.0: build Preprocessing library helloworld-0.1.0.0... [1 of 1] Compiling Lib ( src/Lib.hs, .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/Lib.o ) In-place registering helloworld-0.1.0.0... Preprocessing executable 'helloworld-exe' for helloworld-0.1.0.0... [1 of 1] Compiling Main ( app/Main.hs, .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/helloworld-exe/helloworld-exe-tmp/Main.o ) [Lib changed] Linking .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/helloworld-exe/helloworld-exe ... helloworld-0.1.0.0: install Installing library in /home/michael/helloworld/.stack-work/install/x86_64-linux/lts-3.2/7.10.2/lib/x86_64-linux-ghc-7.10.2/helloworld-0.1.0.0-HI1deOtDlWiAIDtsSJiOtw Installing executable(s) in /home/michael/helloworld/.stack-work/install/x86_64-linux/lts-3.2/7.10.2/bin Registering helloworld-0.1.0.0... Completed all 2 actions. ``` This output means that the text package was downloaded, configured, built, and locally installed. Once that was done, we moved on to building our local package (helloworld). At no point did we need to ask stack to build dependencies — it does so automatically. ### extra-deps Let's try a more off-the-beaten-track package: the joke [acme-missiles](http://www.stackage.org/package/acme-missiles) package. Our source code is simple: ```haskell module Lib ( someFunc ) where import Acme.Missiles someFunc :: IO () someFunc = launchMissiles ``` Again, we add this new dependency to the .cabal file like this: ``` library hs-source-dirs: src exposed-modules: Lib build-depends: base >= 4.7 && < 5 , text -- This next line is the new one , acme-missiles default-language: Haskell2010 ``` However, rerunning `stack build` shows us the following error message: ``` michael@d30748af6d3d:~/helloworld$ stack build While constructing the BuildPlan the following exceptions were encountered: -- While attempting to add dependency, Could not find package acme-missiles in known packages -- Failure when adding dependencies: acme-missiles: needed (-any), stack configuration has no specified version (latest applicable is 0.3) needed for package: helloworld-0.1.0.0 Recommended action: try adding the following to your extra-deps in /home/michael/helloworld/stack.yaml - acme-missiles-0.3 You may also want to try the 'stack solver' command ``` It says acme-missiles is "not present in build plan." This brings us to the next major topic in using stack. ## Curated package sets Remember above when `stack new` selected the lts-3.2 resolver for us? That defined our build plan and available packages. When we tried using the text package, it just worked, because it was part of the lts-3.2 *package set*. But acme-missiles is not part of that package set, so building failed. To add this new dependency, we'll use the `extra-deps` field in stack.yaml to define extra dependencies not present in the resolver. With that change, our stack.yaml looks like: ```yaml flags: {} packages: - '.' extra-deps: - acme-missiles-0.3 # not in lts-3.2 resolver: lts-3.2 ``` Now `stack build` will succeed. With that out of the way, let's dig a little bit more into these package sets, also known as *snapshots*. We mentioned lts-3.2, and you can get quite a bit of information about it at [https://www.stackage.org/lts-3.2](https://www.stackage.org/lts-3.2), including: * The appropriate resolver value (`resolver: lts-3.2`, as we used above) * The GHC version used * A full list of all packages available in this snapshot * The ability to perform a Hoogle search on the packages in this snapshot * A [list of all modules](https://www.stackage.org/lts-3.2/docs) in a snapshot, which can be useful when trying to determine which package to add to your .cabal file You can also see a [list of all available snapshots](https://www.stackage.org/snapshots). You'll notice two flavors: LTS (for "Long Term Support") and Nightly. You can read more about them on the [LTS Haskell Github page](https://github.com/fpco/lts-haskell#readme). If you're not sure which to use, start with LTS Haskell (which stack will lean towards by default as well). ## Resolvers and changing your compiler version Let's explore package sets a bit further. Instead of lts-3.2, let's change our stack.yaml file to use [nightly-2015-08-26](https://www.stackage.org/nightly-2015-08-26). Rerunning `stack build` will produce: ``` michael@d30748af6d3d:~/helloworld$ stack build Downloaded nightly-2015-08-26 build plan. Caching build plan stm-2.4.4: configure stm-2.4.4: build stm-2.4.4: install acme-missiles-0.3: configure acme-missiles-0.3: build acme-missiles-0.3: install helloworld-0.1.0.0: configure Configuring helloworld-0.1.0.0... helloworld-0.1.0.0: build Preprocessing library helloworld-0.1.0.0... In-place registering helloworld-0.1.0.0... Preprocessing executable 'helloworld-exe' for helloworld-0.1.0.0... Linking .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/helloworld-exe/helloworld-exe ... helloworld-0.1.0.0: install Installing library in /home/michael/helloworld/.stack-work/install/x86_64-linux/nightly-2015-08-26/7.10.2/lib/x86_64-linux-ghc-7.10.2/helloworld-0.1.0.0-6cKaFKQBPsi7wB4XdqRv8w Installing executable(s) in /home/michael/helloworld/.stack-work/install/x86_64-linux/nightly-2015-08-26/7.10.2/bin Registering helloworld-0.1.0.0... Completed all 3 actions. ``` We can also change resolvers on the command line, which can be useful in a Continuous Integration (CI) setting, like on Travis. For example: ``` michael@d30748af6d3d:~/helloworld$ stack --resolver lts-3.1 build Downloaded lts-3.1 build plan. Caching build plan stm-2.4.4: configure # Rest is the same, no point copying it ``` When passed on the command line, you also get some additional "short-cut" versions of resolvers: `--resolver nightly` will use the newest Nightly resolver available, `--resolver lts` will use the newest LTS, and `--resolver lts-2` will use the newest LTS in the 2.X series. The reason these are only available on the command line and not in your stack.yaml file is that using them: 1. Will slow down your build (since stack then needs to download information on the latest available LTS each time it builds) 2. Produces unreliable results (since a build run today may proceed differently tomorrow because of changes outside of your control) ### Changing GHC versions Finally, let's try using an older LTS snapshot. We'll use the newest 2.X snapshot: ``` michael@d30748af6d3d:~/helloworld$ stack --resolver lts-2 build Selected resolver: lts-2.22 Downloaded lts-2.22 build plan. Caching build plan No GHC found, expected version 7.8.4 (x86_64) (based on resolver setting in /home/michael/helloworld/stack.yaml). Try running stack setup ``` This fails, because GHC 7.8.4 (which lts-2.22 uses) is not available on our system. So, we see that different LTS versions (2 vs 3 in this case) use different GHC versions. Now, how do we get the right GHC version after changing the LTS version? One answer is to use `stack setup` like we did above, this time with the `--resolver lts-2` option. However, there's another method worth mentioning: the `--install-ghc` flag. ``` michael@d30748af6d3d:~/helloworld$ stack --resolver lts-2 --install-ghc build Selected resolver: lts-2.22 Downloaded ghc-7.8.4. Installed GHC. stm-2.4.4: configure # Mostly same as before, nothing interesting to see ``` What's nice about `--install-ghc` is: 1. You don't need to have an extra step in your build script 2. It only requires downloading the information on latest snapshots once As mentioned above, the default behavior of stack is to *not* install new versions of GHC automatically. We want to avoid surprising users with large downloads/installs. The `--install-ghc` flag simply changes that default behavior. ### Other resolver values We've mentioned `nightly-YYYY-MM-DD` and `lts-X.Y` values for the resolver. There are actually other options available, and the list will grow over time. At the time of writing: * `ghc-X.Y.Z`, for requiring a specific GHC version but no additional packages * Experimental GHCJS support * Experimental custom snapshot support The most up-to-date information can always be found in the [stack.yaml documentation](yaml_configuration.md#resolver). ## Existing projects Alright, enough playing around with simple projects. Let's take an open source package and try to build it. We'll be ambitious and use [yackage](https://www.stackage.org/package/yackage), a local package server using [Yesod](http://www.yesodweb.com/). To get the code, we'll use the `stack unpack` command: ``` cueball:~$ stack unpack yackage-0.8.0 Unpacked yackage-0.8.0 to /var/home/harendra/yackage-0.8.0/ cueball:~$ cd yackage-0.8.0/ ``` ### stack init This new directory does not have a stack.yaml file, so we need to make one first. We could do it by hand, but let's be lazy instead with the `stack init` command: ``` cueball:~/yackage-0.8.0$ stack init Using cabal packages: - yackage.cabal Selecting the best among 6 snapshots... * Matches lts-4.1 Selected resolver: lts-4.1 Initialising configuration using resolver: lts-4.1 Total number of user packages considered: 1 Writing configuration to file: stack.yaml All done. ``` stack init does quite a few things for you behind the scenes: * Finds all of the .cabal files in your current directory and subdirectories (unless you use `--ignore-subdirs`) and determines the packages and versions they require * Finds the best combination of snapshot and package flags that allows everything to compile with minimum external dependencies * It tries to look for the best matching snapshot from latest LTS, latest nightly, other LTS versions in that order Assuming it finds a match, it will write your stack.yaml file, and everything will work. #### External Dependencies Given that LTS Haskell and Stackage Nightly have ~1400 of the most common Haskell packages, this will often be enough to build most packages. However, at times, you may find that not all dependencies required may be available in the Stackage snapshots. Let's simulate an unsatisfied dependency by adding acme-missiles to our build-depends and re-initing: ``` cueball:~/yackage-0.8.0$ stack init --force Using cabal packages: - yackage.cabal Selecting the best among 6 snapshots... * Partially matches lts-4.1 acme-missiles not found - yackage requires -any - yackage flags: upload = True * Partially matches nightly-2016-01-16 acme-missiles not found - yackage requires -any - yackage flags: upload = True * Partially matches lts-3.22 acme-missiles not found - yackage requires -any - yackage flags: upload = True . . . Selected resolver: lts-4.1 Resolver 'lts-4.1' does not have all the packages to match your requirements. acme-missiles not found - yackage requires -any - yackage flags: upload = True However, you can try '--solver' to use external packages. ``` stack has tested six different snapshots, and in every case discovered that acme-missiles is not available. In the end it suggested that you use the `--solver` command line switch if you want to use packages outside Stackage. So let's give it a try: ``` cueball:~/yackage-0.8.0$ stack init --force --solver Using cabal packages: - yackage.cabal Selecting the best among 6 snapshots... * Partially matches lts-4.1 acme-missiles not found - yackage requires -any - yackage flags: upload = True . . . Selected resolver: lts-4.1 *** Resolver lts-4.1 will need external packages: acme-missiles not found - yackage requires -any - yackage flags: upload = True Using resolver: lts-4.1 Using compiler: ghc-7.10.3 Asking cabal to calculate a build plan... Trying with packages from lts-4.1 as hard constraints... Successfully determined a build plan with 3 external dependencies. Initialising configuration using resolver: lts-4.1 Total number of user packages considered: 1 Warning! 3 external dependencies were added. Overwriting existing configuration file: stack.yaml All done. ``` As you can verify by viewing stack.yaml, three external dependencies were added by stack init: ``` # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) extra-deps: - acme-missiles-0.3 - text-1.2.2.0 - yaml-0.8.15.2 ``` Of course, you could have added the external dependencies by manually editing stack.yaml but stack init does the hard work for you. #### Excluded Packages Sometimes multiple packages in your project may have conflicting requirements. In that case `stack init` will fail, so what do you do? You could manually create stack.yaml by omitting some packages to resolve the conflict. Alternatively you can ask `stack init` to do that for you by specifying `--omit-packages` flag on the command line. Let's see how that works. To simulate a conflict we will use acme-missiles-0.3 in yackage and we will also copy yackage.cabal to another directory and change the name of the file and package to yackage-test. In this new package we will use acme-missiles-0.2 instead. Let's see what happens when we run solver: ``` cueball:~/yackage-0.8.0$ stack init --force --solver --omit-packages Using cabal packages: - yackage.cabal - example/yackage-test.cabal Selecting the best among 6 snapshots... * Partially matches lts-4.2 acme-missiles not found - yackage requires ==0.3 - yackage-test requires ==0.2 - yackage flags: upload = True - yackage-test flags: upload = True . . . *** Failed to arrive at a workable build plan. *** Ignoring package: yackage-test *** Resolver lts-4.2 will need external packages: acme-missiles not found - yackage requires ==0.3 - yackage flags: upload = True Using resolver: lts-4.2 Using compiler: ghc-7.10.3 Asking cabal to calculate a build plan... Trying with packages from lts-4.2 as hard constraints... Successfully determined a build plan with 3 external dependencies. Initialising configuration using resolver: lts-4.2 Total number of user packages considered: 2 Warning! Ignoring 1 packages due to dependency conflicts: - "example/yackage-test.cabal" Warning! 3 external dependencies were added. Overwriting existing configuration file: stack.yaml All done. ``` Looking at `stack.yaml`, you will see that the excluded packages have been commented out: ``` # Local packages, usually specified by relative directory name packages: - '.' # The following packages have been ignored due to incompatibility with the resolver compiler or dependency conflicts with other packages #- example/ ``` In case wrong packages are excluded you can uncomment the right one and comment the other one. Packages may get excluded due to conflicting requirements among user packages or due to conflicting requirements between a user package and the resolver compiler. If all of the packages have a conflict with the compiler then all of them may get commented out. When packages are commented out you will see a warning every time you run a command which needs the config file. The warning can be disabled by editing the config file and removing it. #### Using a specific resolver Sometimes you may want to use a specific resolver for your project instead of `stack init` picking one for you. You can do that by using `stack init --resolver `. You can also init with a compiler resolver if you do not want to use a snapshot. That will result in all of your project's dependencies being put under the `extra-deps` section. #### Installing the compiler You can install the required compiler if not already installed by using the `--install-ghc` flag with the `stack init` command. #### Miscellaneous and diagnostics _Add selected packages_: If you want to use only selected packages from your project directory you can do so by explicitly specifying the package directories on the command line. _Duplicate package names_: If multiple packages under the directory tree have same name, stack init will report those and automatically ignore one of them. _Ignore subdirectories_: By default stack init searches all the subdirectories for .cabal files. If you do not want that then you can use `--ignore-subdirs` command line switch. _Cabal warnings_: stack init will show warnings if there were issues in reading a cabal package file. You may want to pay attention to the warnings as sometimes they may result in incomprehensible errors later on during dependency solving. _Package naming_: If the `Name` field defined in a cabal file does not match with the cabal file name then `stack init` will refuse to continue. _Cabal install errors_: stack init uses `cabal-install` to determine external dependencies. When cabal-install encounters errors, cabal errors are displayed as is by stack init for diagnostics. _User warnings_: When packages are excluded or external dependencies added stack will show warnings every time configuration file is loaded. You can suppress the warnings by editing the config file and removing the warnings from it. You may see something like this: ``` cueball:~/yackage-0.8.0$ stack build Warning: Some packages were found to be incompatible with the resolver and have been left commented out in the packages section. Warning: Specified resolver could not satisfy all dependencies. Some external packages have been added as dependencies. You can suppress this message by removing it from stack.yaml ``` ### stack solver While `stack init` is used to create stack configuration file from existing cabal files, `stack solver` can be used to fine tune or fix an existing stack configuration file. `stack solver` uses the existing file as a constraint. For example it will use only those packages specified in the existing config file or use existing external dependencies as constraints to figure out other dependencies. Let's try `stack solver` to verify the config that we generated earlier with `stack init`: ``` cueball:~/yackage-0.8.0$ stack solver Using configuration file: stack.yaml The following packages are missing from the config: - example/yackage-test.cabal Using cabal packages: - yackage.cabal Using resolver: lts-4.2 Using compiler: ghc-7.10.3 Asking cabal to calculate a build plan... Trying with packages from lts-4.2 and 3 external packages as hard constraints... Successfully determined a build plan with 3 external dependencies. No changes needed to stack.yaml ``` It says there are no changes needed to your config. Notice that it also reports `example/yackage-test.cabal` as missing from the config. It was purposely omitted by `stack init` to resolve a conflict. Sometimes `stack init` may not be able to give you a perfect configuration. In that case, you can tweak the configuration file as per your requirements and then run `stack solver`, it will check the file and suggest or apply any fixes needed. For example, if `stack init` ignored certain packages due to name conflicts or dependency conflicts, the choice that `stack init` made may not be the correct one. In that case you can revert the choice and use solver to fix things. Let's try commenting out `.` and uncommenting `examples/` in our previously generated `stack.yaml` and then run `stack solver`: ``` cueball:~/yackage-0.8.0$ stack solver Using configuration file: stack.yaml The following packages are missing from the config: - yackage.cabal Using cabal packages: - example/yackage-test.cabal . . . Retrying with packages from lts-4.2 and 3 external packages as preferences... Successfully determined a build plan with 5 external dependencies. The following changes will be made to stack.yaml: * Resolver is lts-4.2 * Dependencies to be added extra-deps: - acme-missiles-0.2 - email-validate-2.2.0 - tar-0.5.0.1 * Dependencies to be deleted extra-deps: - acme-missiles-0.3 To automatically update stack.yaml, rerun with '--update-config' ``` Due to the change that we made, solver suggested some new dependencies. By default it does not make changes to the config. As it suggested you can use `--update-config` to make changes to the config. NOTE: You should probably back up your stack.yaml before doing this, such as committing to Git/Mercurial/Darcs. Sometimes, you may want to use specific versions of certain packages for your project. To do that you can fix those versions by specifying them in the extra-deps section and then use `stack solver` to figure out whether it is feasible to use those or what other dependencies are needed as a result. If you want to change the resolver for your project, you can run `stack solver --resolver ` and it will figure out the changes needed for you. Let's see what happens if we change the resolver to lts-2.22: ``` cueball:~/yackage-0.8.0$ stack solver --resolver lts-2.22 Using configuration file: stack.yaml The following packages are missing from the config: - yackage.cabal Using cabal packages: - example/yackage-test.cabal Using resolver: lts-2.22 Using compiler: ghc-7.8.4 . . . Retrying with packages from lts-2.22 and 3 external packages as preferences... Successfully determined a build plan with 19 external dependencies. The following changes will be made to stack.yaml: * Resolver is lts-2.22 * Flags to be added flags: - old-locale: true * Dependencies to be added extra-deps: - acme-missiles-0.2 - aeson-0.10.0.0 - aeson-compat-0.3.0.0 - attoparsec-0.13.0.1 - conduit-extra-1.1.9.2 - email-validate-2.2.0 - hex-0.1.2 - http-api-data-0.2.2 - http2-1.1.0 - persistent-2.2.4 - persistent-template-2.1.5 - primitive-0.6.1.0 - tar-0.5.0.1 - unix-time-0.3.6 - vector-0.11.0.0 - wai-extra-3.0.14 - warp-3.1.3.1 * Dependencies to be deleted extra-deps: - acme-missiles-0.3 To automatically update stack.yaml, rerun with '--update-config' ``` As you can see, it automatically suggested changes in `extra-deps` due to the change of resolver. ## Different databases Time to take a short break from hands-on examples and discuss a little architecture. stack has the concept of multiple *databases*. A database consists of a GHC package database (which contains the compiled version of a library), executables, and a few other things as well. To give you an idea: ``` michael@d30748af6d3d:~/helloworld$ ls .stack-work/install/x86_64-linux/lts-3.2/7.10.2/ bin doc flag-cache lib pkgdb ``` Databases in stack are *layered*. For example, the database listing we just gave is called a *local* database. That is layered on top of a *snapshot* database, which contains the libraries and executables specified in the snapshot itself. Finally, GHC itself ships with a number of libraries and executables, which forms the *global* database. To get a quick idea of this, we can look at the output of the `stack exec ghc-pkg list` command in our helloworld project: ``` /home/michael/.stack/programs/x86_64-linux/ghc-7.10.2/lib/ghc-7.10.2/package.conf.d Cabal-1.22.4.0 array-0.5.1.0 base-4.8.1.0 bin-package-db-0.0.0.0 binary-0.7.5.0 bytestring-0.10.6.0 containers-0.5.6.2 deepseq-1.4.1.1 directory-1.2.2.0 filepath-1.4.0.0 ghc-7.10.2 ghc-prim-0.4.0.0 haskeline-0.7.2.1 hoopl-3.10.0.2 hpc-0.6.0.2 integer-gmp-1.0.0.0 pretty-1.1.2.0 process-1.2.3.0 rts-1.0 template-haskell-2.10.0.0 terminfo-0.4.0.1 time-1.5.0.1 transformers-0.4.2.0 unix-2.7.1.0 xhtml-3000.2.1 /home/michael/.stack/snapshots/x86_64-linux/nightly-2015-08-26/7.10.2/pkgdb stm-2.4.4 /home/michael/helloworld/.stack-work/install/x86_64-linux/nightly-2015-08-26/7.10.2/pkgdb acme-missiles-0.3 helloworld-0.1.0.0 ``` Notice that acme-missiles ends up in the *local* database. Anything which is not installed from a snapshot ends up in the local database. This includes: your own code, extra-deps, and in some cases even snapshot packages, if you modify them in some way. The reason we have this structure is that: * it lets multiple projects reuse the same binary builds of many snapshot packages, * but doesn't allow different projects to "contaminate" each other by putting non-standard content into the shared snapshot database Typically, the process by which a snapshot package is marked as modified is referred to as "promoting to an extra-dep," meaning we treat it just like a package in the extra-deps section. This happens for a variety of reasons, including: * changing the version of the snapshot package * changing build flags * one of the packages that the package depends on has been promoted to an extra-dep As you probably guessed, there are multiple snapshot databases available, e.g.: ``` michael@d30748af6d3d:~/helloworld$ ls ~/.stack/snapshots/x86_64-linux/ lts-2.22 lts-3.1 lts-3.2 nightly-2015-08-26 ``` These databases don't get layered on top of each other; they are each used separately. In reality, you'll rarely — if ever — interact directly with these databases, but it's good to have a basic understanding of how they work so you can understand why rebuilding may occur at different points. ## The build synonyms Let's look at a subset of the `stack --help` output: ``` build Build the package(s) in this directory/configuration install Shortcut for 'build --copy-bins' test Shortcut for 'build --test' bench Shortcut for 'build --bench' haddock Shortcut for 'build --haddock' ``` Note that four of these commands are just synonyms for the `build` command. They are provided for convenience for common cases (e.g., `stack test` instead of `stack build --test`) and so that commonly expected commands just work. What's so special about these commands being synonyms? It allows us to make much more composable command lines. For example, we can have a command that builds executables, generates Haddock documentation (Haskell API-level docs), and builds and runs your test suites, with: ``` stack build --haddock --test ``` You can even get more inventive as you learn about other flags. For example, take the following: ``` stack build --pedantic --haddock --test --exec "echo Yay, it succeeded" --file-watch ``` This will: * turn on all warnings and errors * build your library and executables * generate Haddocks * build and run your test suite * run the command `echo Yay, it succeeded` when that completes * after building, watch for changes in the files used to build the project, and kick off a new build when done ### install and copy-bins It's worth calling out the behavior of the install command and `--copy-bins` option, since this has confused a number of users (especially when compared to behavior of other tools like cabal-install). The `install` command does precisely one thing in addition to the build command: it copies any generated executables to the local bin path. You may recognize the default value for that path: ``` michael@d30748af6d3d:~/helloworld$ stack path --local-bin-path /home/michael/.local/bin ``` That's why the download page recommends adding that directory to your `PATH` environment variable. This feature is convenient, because now you can simply run `executable-name` in your shell instead of having to run `stack exec executable-name` from inside your project directory. Since it's such a point of confusion, let me list a number of things stack does *not* do specially for the install command: * stack will always build any necessary dependencies for your code. The install command is not necessary to trigger this behavior. If you just want to build a project, run `stack build`. * stack will *not* track which files it's copied to your local bin path nor provide a way to automatically delete them. There are many great tools out there for managing installation of binaries, and stack does not attempt to replace those. * stack will not necessarily be creating a relocatable executable. If your executables hard-codes paths, copying the executable will not change those hard-coded paths. * At the time of writing, there's no way to change those kinds of paths with stack, but see [issue #848 about --prefix](https://github.com/commercialhaskell/stack/issues/848) for future plans. That's really all there is to the install command: for the simplicity of what it does, it occupies a much larger mental space than is warranted. ## Targets, locals, and extra-deps We haven't discussed this too much yet, but, in addition to having a number of synonyms *and* taking a number of options on the command line, the build command *also* takes many arguments. These are parsed in different ways, and can be used to achieve a high level of flexibility in telling stack exactly what you want to build. We're not going to cover the full generality of these arguments here; instead, there's [documentation covering the full build command syntax](build_command.md). Here, we'll just point out a few different types of arguments: * You can specify a *package name*, e.g. `stack build vector`. * This will attempt to build the vector package, whether it's a local package, in your extra-deps, in your snapshot, or just available upstream. If it's just available upstream but not included in your locals, extra-deps, or snapshot, the newest version is automatically promoted to an extra-dep. * You can also give a *package identifier*, which is a package name plus version, e.g. `stack build yesod-bin-1.4.14`. * This is almost identical to specifying a package name, except it will (1) choose the given version instead of latest, and (2) error out if the given version conflicts with the version of a local package. * The most flexibility comes from specifying individual *components*, e.g. `stack build helloworld:test:helloworld-test` says "build the test suite component named helloworld-test from the helloworld package." * In addition to this long form, you can also shorten it by skipping what type of component it is, e.g. `stack build helloworld:helloworld-test`, or even skip the package name entirely, e.g. `stack build :helloworld-test`. * Finally, you can specify individual *directories* to build to trigger building of any local packages included in those directories or subdirectories. When you give no specific arguments on the command line (e.g., `stack build`), it's the same as specifying the names of all of your local packages. If you just want to build the package for the directory you're currently in, you can use `stack build .`. ### Components, --test, and --bench Here's one final important yet subtle point. Consider our helloworld package: it has a library component, an executable helloworld-exe, and a test suite helloworld-test. When you run `stack build helloworld`, how does it know which ones to build? By default, it will build the library (if any) and all of the executables but ignore the test suites and benchmarks. This is where the `--test` and `--bench` flags come into play. If you use them, those components will also be included. So `stack build --test helloworld` will end up including the helloworld-test component as well. You can bypass this implicit adding of components by being much more explicit, and stating the components directly. For example, the following will not build the helloworld-exe executable: ``` michael@d30748af6d3d:~/helloworld$ stack clean michael@d30748af6d3d:~/helloworld$ stack build :helloworld-test helloworld-0.1.0.0: configure (test) Configuring helloworld-0.1.0.0... helloworld-0.1.0.0: build (test) Preprocessing library helloworld-0.1.0.0... [1 of 1] Compiling Lib ( src/Lib.hs, .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/Lib.o ) In-place registering helloworld-0.1.0.0... Preprocessing test suite 'helloworld-test' for helloworld-0.1.0.0... [1 of 1] Compiling Main ( test/Spec.hs, .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/helloworld-test/helloworld-test-tmp/Main.o ) Linking .stack-work/dist/x86_64-linux/Cabal-1.22.4.0/build/helloworld-test/helloworld-test ... helloworld-0.1.0.0: test (suite: helloworld-test) Test suite not yet implemented ``` We first cleaned our project to clear old results so we know exactly what stack is trying to do. Notice that it builds the helloworld-test test suite, and the helloworld library (since it's used by the test suite), but it does not build the helloworld-exe executable. And now the final point: the last line shows that our command also *runs* the test suite it just built. This may surprise some people who would expect tests to only be run when using `stack test`, but this design decision is what allows the `stack build` command to be as composable as it is (as described previously). The same rule applies to benchmarks. To spell it out completely: * The --test and --bench flags simply state which components of a package should be built, if no explicit set of components is given * The default behavior for any test suite or benchmark component which has been built is to also run it You can use the `--no-run-tests` and `--no-run-benchmarks` (from stack-0.1.4.0 and on) flags to disable running of these components. You can also use `--no-rerun-tests` to prevent running a test suite which has already passed and has not changed. NOTE: stack doesn't build or run test suites and benchmarks for non-local packages. This is done so that running a command like `stack test` doesn't need to run 200 test suites! ## Multi-package projects Until now, everything we've done with stack has used a single-package project. However, stack's power truly shines when you're working on multi-package projects. All the functionality you'd expect to work just does: dependencies between packages are detected and respected, dependencies of all packages are just as one cohesive whole, and if anything fails to build, the build commands exits appropriately. Let's demonstrate this with the wai-app-static and yackage packages: ``` michael@d30748af6d3d:~$ mkdir multi michael@d30748af6d3d:~$ cd multi/ michael@d30748af6d3d:~/multi$ stack unpack wai-app-static-3.1.1 yackage-0.8.0 wai-app-static-3.1.1: download Unpacked wai-app-static-3.1.1 to /home/michael/multi/wai-app-static-3.1.1/ Unpacked yackage-0.8.0 to /home/michael/multi/yackage-0.8.0/ michael@d30748af6d3d:~/multi$ stack init Writing default config file to: /home/michael/multi/stack.yaml Basing on cabal files: - /home/michael/multi/yackage-0.8.0/yackage.cabal - /home/michael/multi/wai-app-static-3.1.1/wai-app-static.cabal Checking against build plan lts-3.2 Selected resolver: lts-3.2 Wrote project config to: /home/michael/multi/stack.yaml michael@d30748af6d3d:~/multi$ stack build --haddock --test # Goes off to build a whole bunch of packages ``` If you look at the stack.yaml, you'll see exactly what you'd expect: ```yaml flags: yackage: upload: true wai-app-static: print: false packages: - yackage-0.8.0/ - wai-app-static-3.1.1/ extra-deps: [] resolver: lts-3.2 ``` Notice that multiple directories are listed in the `packages` key. In addition to local directories, you can also refer to packages available in a Git repository or in a tarball over HTTP/HTTPS. This can be useful for using a modified version of a dependency that hasn't yet been released upstream. Please note that when adding upstream packages directly to your project it is important to distinguish _local packages_ from the upstream _dependency packages_. Otherwise you may have trouble running `stack GHCi`. See [stack.yaml documentation](yaml_configuration.md#packages) for more details. ## Flags and GHC options There are two common ways to alter how a package will install: with Cabal flags and with GHC options. ### Cabal flag management In the stack.yaml file above, you can see that `stack init` has detected that — for the yackage package — the upload flag can be set to true, and for wai-app-static, the print flag to false (it's chosen those values because they're the default flag values, and their dependencies are compatible with the snapshot we're using.) To change a flag setting, we can use the command line `--flag` option: stack build --flag yackage:-upload This means: when compiling the yackage package, turn off the upload flag (thus the `-`). Unlike other tools, stack is explicit about which package's flag you want to change. It does this for two reasons: 1. There's no global meaning for Cabal flags, and therefore two packages can use the same flag name for completely different things. 2. By following this approach, we can avoid unnecessarily recompiling snapshot packages that happen to use a flag that we're using. You can also change flag values on the command line for extra-dep and snapshot packages. If you do this, that package will automatically be promoted to an extra-dep, since the build plan is different than what the plan snapshot definition would entail. ### GHC options GHC options follow a similar logic as in managing Cabal flags, with a few nuances to adjust for common use cases. Let's consider: stack build --ghc-options="-Wall -Werror" This will set the `-Wall -Werror` options for all *local targets*. Note that this will not affect extra-dep and snapshot packages at all. This design provides us with reproducible and fast builds. (By the way: the above GHC options have a special convenience flag: `--pedantic`.) There's one extra nuance about command line GHC options: Since they only apply to local targets, if you change your local targets, they will no longer apply to other packages. Let's play around with an example from the wai repository, which includes the wai and warp packages, the latter depending on the former. If we run: stack build --ghc-options=-O0 wai It will build all of the dependencies of wai, and then build wai with all optimizations disabled. Now let's add in warp as well: stack build --ghc-options=-O0 wai warp This builds the additional dependencies for warp, and then builds warp with optimizations disabled. Importantly: it does not rebuild wai, since wai's configuration has not been altered. Now the surprising case: ``` michael@d30748af6d3d:~/wai$ stack build --ghc-options=-O0 warp wai-3.0.3.0-5a49351d03cba6cbaf906972d788e65d: unregistering (flags changed from ["--ghc-options","-O0"] to []) warp-3.1.3-a91c7c3108f63376877cb3cd5dbe8a7a: unregistering (missing dependencies: wai) wai-3.0.3.0: configure ``` You may expect this to be a no-op: neither wai nor warp has changed. However, stack will instead recompile wai with optimizations enabled again, and then rebuild warp (with optimizations disabled) against this newly built wai. The reason: reproducible builds. If we'd never built wai or warp before, trying to build warp would necessitate building all of its dependencies, and it would do so with default GHC options (optimizations enabled). This dependency would include wai. So when we run: stack build --ghc-options=-O0 warp We want its behavior to be unaffected by any previous build steps we took. While this specific corner case does catch people by surprise, the overall goal of reproducible builds is- in the stack maintainers' views- worth the confusion. Final point: if you have GHC options that you'll be regularly passing to your packages, you can add them to your stack.yaml file (starting with stack-0.1.4.0). See [the documentation section on ghc-options](yaml_configuration.md#ghc-options) for more information. ## path NOTE: That's it, the heavy content of this guide is done! Everything from here on out is simple explanations of commands. Congratulations! Generally, you don't need to worry about where stack stores various files. But some people like to know this stuff. That's when the `stack path` command is useful. ``` michael@d30748af6d3d:~/wai$ stack path global-stack-root: /home/michael/.stack stack-root: /home/michael/.stack project-root: /home/michael/wai config-location: /home/michael/wai/stack.yaml bin-path: /home/michael/.stack/snapshots/x86_64-linux/lts-2.17/7.8.4/bin:/home/michael/.stack/programs/x86_64-linux/ghc-7.8.4/bin:/home/michael/.stack/programs/x86_64-linux/ghc-7.10.2/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin programs: /home/michael/.stack/programs/x86_64-linux compiler: /home/michael/.stack/programs/x86_64-linux/ghc-7.8.4/bin/ghc compiler-bin: /home/michael/.stack/programs/x86_64-linux/ghc-7.8.4/bin local-bin-path: /home/michael/.local/bin extra-include-dirs: extra-library-dirs: snapshot-pkg-db: /home/michael/.stack/snapshots/x86_64-linux/lts-2.17/7.8.4/pkgdb local-pkg-db: /home/michael/wai/.stack-work/install/x86_64-linux/lts-2.17/7.8.4/pkgdb global-pkg-db: /home/michael/.stack/programs/x86_64-linux/ghc-7.8.4/lib/ghc-7.8.4/package.conf.d ghc-package-path: /home/michael/wai/.stack-work/install/x86_64-linux/lts-2.17/7.8.4/pkgdb:/home/michael/.stack/snapshots/x86_64-linux/lts-2.17/7.8.4/pkgdb:/home/michael/.stack/programs/x86_64-linux/ghc-7.8.4/lib/ghc-7.8.4/package.conf.d snapshot-install-root: /home/michael/.stack/snapshots/x86_64-linux/lts-2.17/7.8.4 local-install-root: /home/michael/wai/.stack-work/install/x86_64-linux/lts-2.17/7.8.4 snapshot-doc-root: /home/michael/.stack/snapshots/x86_64-linux/lts-2.17/7.8.4/doc local-doc-root: /home/michael/wai/.stack-work/install/x86_64-linux/lts-2.17/7.8.4/doc dist-dir: .stack-work/dist/x86_64-linux/Cabal-1.18.1.5 local-hpc-root: /home/michael/wai/.stack-work/install/x86_64-linux/lts-2.17/7.8.4/hpc ``` In addition, `stack path` accepts command line arguments to state which of these keys you're interested in, which can be convenient for scripting. As a simple example, let's find out which versions of GHC are installed locally: ``` michael@d30748af6d3d:~/wai$ ls $(stack path --programs)/*.installed /home/michael/.stack/programs/x86_64-linux/ghc-7.10.2.installed /home/michael/.stack/programs/x86_64-linux/ghc-7.8.4.installed ``` (Yes, that command requires a \*nix shell, and likely won't run on Windows.) While we're talking about paths, to wipe our stack install completely, here's what needs to be removed: 1. The stack executable itself 2. The stack root, e.g. `$HOME/.stack` on non-Windows systems. * See `stack path --stack-root` * On Windows, you will also need to delete `stack path --programs` 3. Any local `.stack-work` directories inside a project ## exec We've already used `stack exec` used multiple times in this guide. As you've likely already guessed, it allows you to run executables, but with a slightly modified environment. In particular: `stack exec` looks for executables on stack's bin paths, and sets a few additional environment variables (like `GHC_PACKAGE_PATH`, which tells GHC which package databases to use). If you want to see exactly what the modified environment looks like, try: stack exec env The only issue is how to distinguish flags to be passed to stack versus those for the underlying program. Thanks to the optparse-applicative library, stack follows the Unix convention of `--` to separate these, e.g.: ``` michael@d30748af6d3d:~$ stack exec --package stm -- echo I installed the stm package via --package stm Run from outside a project, using implicit global project config Using latest snapshot resolver: lts-3.2 Writing global (non-project-specific) config file to: /home/michael/.stack/global/stack.yaml Note: You can change the snapshot via the resolver field there. I installed the stm package via --package stm ``` Flags worth mentioning: * `--package foo` can be used to force a package to be installed before running the given command. * `--no-ghc-package-path` can be used to stop the `GHC_PACKAGE_PATH` environment variable from being set. Some tools — notably cabal-install — do not behave well with that variable set. ## ghci (the repl) GHCi is the interactive GHC environment, a.k.a. the REPL. You *could* access it with: stack exec ghci But that won't load up locally written modules for access. For that, use the `stack ghci` command. To then load modules from your project, use the `:m` command (for "module") followed by the module name. IMPORTANT NOTE: If you have added upstream packages to your project please make sure to mark them as *dependency package*s for faster and reliable usage of `stack gchi`. Otherwise GHCi may have trouble due to conflicts of compilation flags or having to unnecessarily interpret too many modules. See [stack.yaml documentation](yaml_configuration.md#packages) to learn how to mark a package as a *dependency package*. ## ghc/runghc You'll sometimes want to just compile (or run) a single Haskell source file, instead of creating an entire Cabal package for it. You can use `stack exec ghc` or `stack exec runghc` for that. As simple helpers, we also provide the `stack ghc` and `stack runghc` commands, for these common cases. ## script interpreter stack also offers a very useful feature for running files: a script interpreter. For too long have Haskellers felt shackled to bash or Python because it's just too hard to create reusable source-only Haskell scripts. stack attempts to solve that. You can use `stack ` to execute a Haskell source file or specify `stack` as the interpreter using a shebang line on a Unix like operating systems. Additional stack options can be specified using a special Haskell comment in the source file to specify dependencies and automatically install them before running the file. An example will be easiest to understand: ``` michael@d30748af6d3d:~$ cat turtle.hs #!/usr/bin/env stack -- stack --resolver lts-3.2 --install-ghc runghc --package turtle {-# LANGUAGE OverloadedStrings #-} import Turtle main = echo "Hello World!" michael@d30748af6d3d:~$ chmod +x turtle.hs michael@d30748af6d3d:~$ ./turtle.hs Run from outside a project, using implicit global project config Using resolver: lts-3.2 specified on command line hashable-1.2.3.3: configure # installs some more dependencies Completed all 22 actions. Hello World! michael@d30748af6d3d:~$ ./turtle.hs Run from outside a project, using implicit global project config Using resolver: lts-3.2 specified on command line Hello World! ``` The first run can take a while (as it has to download GHC if necessary and build dependencies), but subsequent runs are able to reuse everything already built, and are therefore quite fast. The first line in the source file is the usual "shebang" to use stack as a script interpreter. The second line, is a Haskell comment providing additional options to stack (due to the common limitation of the "shebang" line only being allowed a single argument). In this case, the options tell stack to use the lts-3.2 resolver, automatically install GHC if it is not already installed, and ensure the turtle package is available. If you're on Windows: you can run `stack turtle.hs` instead of `./turtle.hs`. The shebang line is not required in that case. ### Specifying interpreter options The stack interpreter options comment must specify a single valid stack command line, starting with `stack` as the command followed by the stack options to use for executing this file. The comment must always be on the line immediately following the shebang line when the shebang line is present otherwise it must be the first line in the file. The comment must always start in the first column of the line. When many options are needed a block style comment may be more convenient to split the command on multiple lines for better readability. Here is an example of a multi line block comment: ``` #!/usr/bin/env stack {- stack --resolver lts-3.2 --install-ghc runghc --package turtle -} ``` ## Finding project configs, and the implicit global Whenever you run something with stack, it needs a stack.yaml project file. The algorithm stack uses to find this is: 1. Check for a `--stack-yaml` option on the command line 2. Check for a `STACK_YAML` environment variable 3. Check the current directory and all ancestor directories for a `stack.yaml` The first two provide a convenient method for using an alternate configuration. For example: `stack build --stack-yaml stack-7.8.yaml` can be used by your CI system to check your code against GHC 7.8. Setting the `STACK_YAML` environment variable can be convenient if you're going to be running commands like `stack ghc` in other directories, but you want to use the configuration you defined in a specific project. If stack does not find a stack.yaml in any of the three specified locations, the *implicit global* logic kicks in. You've probably noticed that phrase a few times in the output from commands above. Implicit global is essentially a hack to allow stack to be useful in a non-project setting. When no implicit global config file exists, stack creates one for you with the latest LTS snapshot as the resolver. This allows you to do things like: * compile individual files easily with `stack ghc` * build executables without starting a project, e.g. `stack install pandoc` Keep in mind that there's nothing magical about this implicit global configuration. It has no impact on projects at all. Every package you install with it is put into isolated databases just like everywhere else. The only magic is that it's the catch-all project whenever you're running stack somewhere else. ## stack.yaml vs .cabal files Now that we've covered a lot of stack use cases, this quick summary of stack.yaml vs .cabal files will hopefully make sense and be a good reminder for future uses of stack: * A project can have multiple packages. * Each project has a stack.yaml. * Each package has a .cabal file. * The .cabal file specifies which packages are dependencies. * The stack.yaml file specifies which packages are available to be used. * .cabal specifies the components, modules, and build flags provided by a package * stack.yaml can override the flag settings for individual packages * stack.yaml specifies which packages to include ## Comparison to other tools stack is not the only tool around for building Haskell code. stack came into existence due to limitations with some of the existing tools. If you're unaffected by those limitations and are happily building Haskell code, you may not need stack. If you're suffering from some of the common problems in other tools, give stack a try instead. If you're a new user who has no experience with other tools, we recommend going with stack. The defaults match modern best practices in Haskell development, and there are less corner cases you need to be aware of. You *can* develop Haskell code with other tools, but you probably want to spend your time writing code, not convincing a tool to do what you want. Before jumping into the differences, let me clarify an important similarity: __Same package format.__ stack, cabal-install, and presumably all other tools share the same underlying Cabal package format, consisting of a .cabal file, modules, etc. This is a Good Thing: we can share the same set of upstream libraries, and collaboratively work on the same project with stack, cabal-install, and NixOS. In that sense, we're sharing the same ecosystem. Now the differences: * __Curation vs dependency solving as a default__. * stack defaults to using curation (Stackage snapshots, LTS Haskell, Nightly, etc) as a default instead of defaulting to dependency solving, as cabal-install does. This is just a default: as described above, stack can use dependency solving if desired, and cabal-install can use curation. However, most users will stick to the defaults. The stack team firmly believes that the majority of users want to simply ignore dependency resolution nightmares and get a valid build plan from day 1, which is why we've made this selection of default behavior. * __Reproducible__. * stack goes to great lengths to ensure that `stack build` today does the same thing tomorrow. cabal-install does not: build plans can be affected by the presence of preinstalled packages, and running `cabal update` can cause a previously successful build to fail. With stack, changing the build plan is always an explicit decision. * __Automatically building dependencies__. * In cabal-install, you need to use `cabal install` to trigger dependency building. This is somewhat necessary due to the previous point, since building dependencies can, in some cases, break existing installed packages. So for example, in stack, `stack test` does the same job as `cabal install --run-tests`, though the latter *additionally* performs an installation that you may not want. The closer command equivalent is `cabal install --enable-tests --only-dependencies && cabal configure --enable-tests && cabal build && cabal test` (newer versions of cabal-install may make this command shorter). * __Isolated by default__. * This has been a pain point for new stack users. In cabal, the default behavior is a non-isolated build where working on two projects can cause the user package database to become corrupted. The cabal solution to this is sandboxes. stack, however, provides this behavior by default via its databases. In other words: when you use stack, there's __no need for sandboxes__, everything is (essentially) sandboxed by default. __Other tools for comparison (including active and historical)__ * [cabal-dev](https://hackage.haskell.org/package/cabal-dev) (deprecated in favor of cabal-install) * [cabal-meta](https://hackage.haskell.org/package/cabal-meta) inspired a lot of the multi-package functionality of stack. If you're still using cabal-install, cabal-meta is relevant. For stack work, the feature set is fully subsumed by stack. * [cabal-src](https://hackage.haskell.org/package/cabal-src) is mostly irrelevant in the presence of both stack and cabal sandboxes, both of which make it easier to add additional package sources easily. The mega-sdist executable that ships with cabal-src is, however, still relevant. Its functionality may some day be folded into stack * [stackage-cli](https://hackage.haskell.org/package/stackage-cli) was an initial attempt to make cabal-install work more easily with curated snapshots, but due to a slight impedance mismatch between cabal.config constraints and snapshots, it did not work as well as hoped. It is deprecated in favor of stack. ## More resources There are lots of resources available for learning more about stack: * `stack --help` * `stack --version` — identify the version and Git hash of the stack executable * `--verbose` (or `-v`) — much more info about internal operations (useful for bug reports) * The [home page](http://haskellstack.org) * The [stack mailing list](https://groups.google.com/d/forum/haskell-stack) * The [the FAQ](faq.md) * The [stack wiki](https://github.com/commercialhaskell/stack/wiki) * The [haskell-stack tag on Stack Overflow](http://stackoverflow.com/questions/tagged/haskell-stack) * [Another getting started with stack tutorial](http://seanhess.github.io/2015/08/04/practical-haskell-getting-started.html) * [Why is stack not cabal?](https://www.fpcomplete.com/blog/2015/06/why-is-stack-not-cabal) ## Fun features This is just a quick collection of fun and useful feature stack supports. ### Templates We started off using the `new` command to create a project. stack provides multiple templates to start a new project from: ``` michael@d30748af6d3d:~$ stack templates chrisdone hakyll-template new-template simple yesod-minimal yesod-mongo yesod-mysql yesod-postgres yesod-postgres-fay yesod-simple yesod-sqlite michael@d30748af6d3d:~$ stack new my-yesod-project yesod-simple Downloading template "yesod-simple" to create project "my-yesod-project" in my-yesod-project/ ... Using the following authorship configuration: author-email: example@example.com author-name: Example Author Name Copy these to /home/michael/.stack/config.yaml and edit to use different values. Writing default config file to: /home/michael/my-yesod-project/stack.yaml Basing on cabal files: - /home/michael/my-yesod-project/my-yesod-project.cabal Checking against build plan lts-3.2 Selected resolver: lts-3.2 Wrote project config to: /home/michael/my-yesod-project/stack.yaml ``` To add more templates, see [the stack-templates repository](https://github.com/commercialhaskell/stack-templates#readme). ### IDE stack has a work-in-progress suite of editor integrations, to do things like getting type information in Emacs. For more information, see [stack-ide](https://github.com/commercialhaskell/stack-ide#readme). ### Visualizing dependencies If you'd like to get some insight into the dependency tree of your packages, you can use the `stack dot` command and Graphviz. More information is [available in the Dependency visualization documentation](dependency_visualization.md). ### Travis with caching Many people use Travis CI to test out a project for every Git push. We have [a document devoted to Travis](travis_ci.md). However, for most people, the following example will be sufficient to get started: ```yaml # Copy these contents into the root directory of your Github project in a file # named .travis.yml # Use new container infrastructure to enable caching sudo: false # Choose a lightweight base image; we provide our own build tools. language: c # Caching so the next build will be fast too. cache: directories: - $HOME/.ghc - $HOME/.cabal - $HOME/.stack # The different configurations we want to test. We have BUILD=cabal which uses # cabal-install, and BUILD=stack which uses Stack. More documentation on each # of those below. # # We set the compiler values here to tell Travis to use a different # cache file per set of arguments. # # If you need to have different apt packages for each combination in the # matrix, you can use a line such as: # addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}} matrix: include: # We grab the appropriate GHC and cabal-install versions from hvr's PPA. See: # https://github.com/hvr/multi-ghc-travis #- env: BUILD=cabal GHCVER=7.0.4 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 # compiler: ": #GHC 7.0.4" # addons: {apt: {packages: [cabal-install-1.16,ghc-7.0.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} #- env: BUILD=cabal GHCVER=7.2.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 # compiler: ": #GHC 7.2.2" # addons: {apt: {packages: [cabal-install-1.16,ghc-7.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} #- env: BUILD=cabal GHCVER=7.4.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 # compiler: ": #GHC 7.4.2" # addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} - env: BUILD=cabal GHCVER=7.6.3 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 compiler: ": #GHC 7.6.3" addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} - env: BUILD=cabal GHCVER=7.8.4 CABALVER=1.18 HAPPYVER=1.19.5 ALEXVER=3.1.7 compiler: ": #GHC 7.8.4" addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} - env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 HAPPYVER=1.19.5 ALEXVER=3.1.7 compiler: ": #GHC 7.10.3" addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} # Build with the newest GHC and cabal-install. This is an accepted failure, # see below. - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 compiler: ": #GHC HEAD" addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS # variable, such as using --stack-yaml to point to a different file. - env: BUILD=stack ARGS="" compiler: ": #stack default" addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} - env: BUILD=stack ARGS="--resolver lts-2" compiler: ": #stack 7.8.4" addons: {apt: {packages: [ghc-7.8.4], sources: [hvr-ghc]}} - env: BUILD=stack ARGS="--resolver lts-3" compiler: ": #stack 7.10.2" addons: {apt: {packages: [ghc-7.10.2], sources: [hvr-ghc]}} - env: BUILD=stack ARGS="--resolver lts-5" compiler: ": #stack 7.10.3" addons: {apt: {packages: [ghc-7.10.3], sources: [hvr-ghc]}} # Nightly builds are allowed to fail - env: BUILD=stack ARGS="--resolver nightly" compiler: ": #stack nightly" addons: {apt: {packages: [libgmp,libgmp-dev]}} # Build on OS X in addition to Linux - env: BUILD=stack ARGS="" compiler: ": #stack default osx" os: osx - env: BUILD=stack ARGS="--resolver lts-2" compiler: ": #stack 7.8.4 osx" os: osx - env: BUILD=stack ARGS="--resolver lts-3" compiler: ": #stack 7.10.2 osx" os: osx - env: BUILD=stack ARGS="--resolver lts-5" compiler: ": #stack 7.10.3 osx" os: osx - env: BUILD=stack ARGS="--resolver nightly" compiler: ": #stack nightly osx" os: osx allow_failures: - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 - env: BUILD=stack ARGS="--resolver nightly" before_install: # Using compiler above sets CC to an invalid value, so unset it - unset CC # We want to always allow newer versions of packages when building on GHC HEAD - CABALARGS="" - if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi # Download and unpack the stack executable - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:/opt/alex/$ALEXVER/bin:/opt/happy/$HAPPYVER/bin:$HOME/.cabal/bin:$PATH - mkdir -p ~/.local/bin - | if [ `uname` = "Darwin" ] then travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin else travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' fi # Use the more reliable S3 mirror of Hackage mkdir -p $HOME/.cabal echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config if [ "$CABALVER" != "1.16" ] then echo 'jobs: $ncpus' >> $HOME/.cabal/config fi # Get the list of packages from the stack.yaml file - PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@') install: - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - if [ -f configure.ac ]; then autoreconf -i; fi - | set -ex case "$BUILD" in stack) stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies ;; cabal) cabal --version travis_retry cabal update cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES ;; esac set +ex script: - | set -ex case "$BUILD" in stack) stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps ;; cabal) cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES ORIGDIR=$(pwd) for dir in $PACKAGES do cd $dir cabal check || [ "$CABALVER" == "1.16" ] cabal sdist SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz && \ (cd dist && cabal install --force-reinstalls "$SRC_TGZ") cd $ORIGDIR done ;; esac set +ex ``` Not only will this build and test your project against multiple GHC versions and snapshots, but it will cache your snapshot built packages, meaning that subsequent builds will be much faster. Once Travis whitelists the stack .deb files, we'll be able to simply include stack in the `addons` section, and automatically use the newest version of stack, avoiding that complicated `before_install` section This is being tracked in the [apt-source-whitelist](https://github.com/travis-ci/apt-source-whitelist/pull/7) and [apt-package-whitelist](https://github.com/travis-ci/apt-package-whitelist/issues/379) issue trackers. In case you're wondering: we need `--no-terminal` because stack does some fancy sticky display on smart terminals to give nicer status and progress messages, and the terminal detection is broken on Travis. ### Shell auto-completion Love tab-completion of commands? You're not alone. If you're on bash, just run the following (or add it to `.bashrc`): eval "$(stack --bash-completion-script stack)" For more information and other shells, see [the Shell auto-completion wiki page](https://github.com/commercialhaskell/stack/wiki/Shell-autocompletion) ### Docker stack provides two built-in Docker integrations. Firstly, you can build your code inside a Docker image, which means: * even more reproducibility to your builds, since you and the rest of your team will always have the same system libraries * the Docker images ship with entire precompiled snapshots. That means you have a large initial download, but much faster builds For more information, see [the Docker-integration documentation](docker_integration.md). stack can also generate Docker images for you containing your built executables. This feature is great for automating deployments from CI. This feature is not yet well-documented, but the basics are to add a section like the following to stack.yaml: ```yaml image: # YOU NEED A `container` YAML SECTION FOR `stack image container` container: # YOU NEED A BASE IMAGE NAME. STACK LAYERS EXES ON TOP OF # THE BASE IMAGE. PREPARE YOUR PROJECT IMAGE IN ADVANCE. PUT # ALL YOUR RUNTIME DEPENDENCIES IN THE IMAGE. base: "fpco/ubuntu-with-libgmp:14.04" # YOU CAN OPTIONALY NAME THE IMAGE. STACK WILL USE THE PROJECT # DIRECTORY NAME IF YOU LEAVE OUT THIS OPTION. name: "fpco/hello-world" # OPTIONALLY ADD A HASH OF LOCAL PROJECT DIRECTORIES AND THEIR # DESTINATIONS INSIDE THE DOCKER IMAGE. add: man/: /usr/local/share/man/ # OPTIONALLY SPECIFY A LIST OF EXECUTABLES. STACK WILL CREATE # A TAGGED IMAGE FOR EACH IN THE LIST. THESE IMAGES WILL HAVE # THEIR RESPECTIVE "ENTRYPOINT" SET. entrypoints: - stack ``` and then run `stack image container` and then `docker images` to list the images. ### Nix stack provides an integration with [Nix](http://nixos.org/nix), providing you with the same two benefits as the first Docker integration discussed above: * more reproducible builds, since fixed versions of any system libraries and commands required to build the project are automatically built using Nix and managed locally per-project. These system packages never conflict with any existing versions of these libraries on your system. That they are managed locally to the project means that you don't need to alter your system in any way to build any odd project pulled from the Internet. * implicit sharing of system packages between projects, so you don't have more copies on-disk than you need to. When using the Nix integration, Stack downloads and builds Haskell dependencies as usual, but resorts on Nix to provide non-Haskell dependencies that exist in the Nixpkgs. Both Docker and Nix are methods to *isolate* builds and thereby make them more reproducible. They just differ in the means of achieving this isolation. Nix provides slightly weaker isolation guarantees than Docker, but is more lightweight and more portable (Linux and OS X mainly, but also Windows). For more on Nix, its command-line interface and its package description language, read the [Nix manual](http://nixos.org/nix/manual). But keep in mind that the point of stack's support is to obviate the need to write any Nix code in the common case or even to learn how to use the Nix tools (they're called under the hood). For more information, see [the Nix-integration documentation](nix_integration.md). ## Power user commands The following commands are a little more powerful, and won't be needed by all users. Here's a quick rundown: * `stack update` will download the most recent set of packages from your package indices (e.g. Hackage). Generally, stack runs this for you automatically when necessary, but it can be useful to do this manually sometimes (e.g., before running `stack solver`, to guarantee you have the most recent upstream packages available). * `stack unpack` is a command we've already used quite a bit for examples, but most users won't use it regularly. It does what you'd expect: downloads a tarball and unpacks it. * `stack sdist` generates an uploading tarball containing your package code * `stack upload` uploads an sdist to Hackage. In the future, it will also perform automatic GPG signing of your packages for additional security, when configured. * `--sign` provides a way to GPG sign your package & submit the result to sig.commercialhaskell.org for storage in the sig-archive git repo. (Signatures will be used later to verify package integrity.) * `stack upgrade` will build a new version of stack from source. * `--git` is a convenient way to get the most recent version from master for those testing and living on the bleeding edge. * `stack setup --upgrade-cabal` can install a newer version of the Cabal library, used for performing actual builds. You shouldn't generally do this, since new Cabal versions may introduce incompatibilities with package sets, but it can be useful if you're trying to test a specific bugfix. * `stack list-dependencies` lists all of the packages and versions used for a project * `stack sig` subcommand can help you with GPG signing & verification * `sign` will sign an sdist tarball and submit the signature to sig.commercialhaskell.org for storage in the sig-archive git repo. (Signatures will be used later to verify package integrity.) ## Debugging The following command installs with profiling enabled: `stack install --enable-executable-profiling --enable-library-profiling --ghc-options="-rtsopts"` This command will allow you to use various tools to profile the time, allocation, heap, and more of a program. The `-prof` GHC option is unnecessary and will result in a warning. Additional compilation options can be added to `--ghc-options` if needed. To see a general overview of the time and allocation of a program called `main` compiled with the above command, you can run `./main +RTS -p` to generate a `main.prof` file containing the requested profiling information. Alternatively, you can use `stack exec main -- +RTS -p`, where `--` allows you to specify parameters for `main` executable (without `--` the `stack` executable would use those parameters instead). For more commands and uses, see [the official GHC chapter on profiling](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/profiling.html), [the Haskell wiki](https://wiki.haskell.org/How_to_profile_a_Haskell_program), and [the chapter on profiling in Real World Haskell](http://book.realworldhaskell.org/read/profiling-and-optimization.html). stack-1.1.2/doc/install_and_upgrade.md0000644000000000000000000003122512717707440016110 0ustar0000000000000000# Install/upgrade Distribution packages are available for [Ubuntu](#ubuntu), [Debian](#debian), [CentOS / Red Hat / Amazon Linux](#centos), [Fedora](#fedora), [Arch Linux](#arch-linux) and unofficially [FreeBSD](#freebsd). Binaries for other operating systems are listed below, and available on [the Github releases page](https://github.com/fpco/stack/releases). For the future, we are open to supporting more OSes (to request one, please [submit an issue](https://github.com/commercialhaskell/stack/issues/new)). Binary packages are signed with this [signing key](SIGNING_KEY.md). If you are writing a script that needs to download the latest binary, you can find links that always point to the latest bindists [here](https://www.stackage.org/stack). ## Windows *Note*: Due to specific Windows limitations, [some temporary workarounds](https://www.fpcomplete.com/blog/2015/08/stack-ghc-windows) may be required. It is strongly advised to set your `STACK_ROOT` environment variable similarly to your root (e.g., `set STACK_ROOT=c:\stack_root`) *before* running `stack`. *Note:* while generally 32-bit GHC is better tested on Windows, there are reports that recent versions of Windows only work with the 64-bit version of Stack (see [issue #393](https://github.com/commercialhaskell/stack/issues/393)). ### Installer We recommend installing to the default location with these installers, as that will make `stack install` and `stack upgrade` work correctly out of the box. * [Windows 32-bit Installer](https://www.stackage.org/stack/windows-i386-installer) * [Windows 64-bit Installer](https://www.stackage.org/stack/windows-x86_64-installer) ### Manual download * Download the latest release: * [Windows 32-bit](https://www.stackage.org/stack/windows-i386) * [Windows 64-bit](https://www.stackage.org/stack/windows-x86_64) * Unpack the archive and place `stack.exe` somewhere on your `%PATH%` (see [Path section below](#path)) and you can then run `stack` on the command line. * Now you can run `stack` from the terminal. NOTE: These executables have been built and tested on a Windows 7, 8.1, and 10 64-bit machines. They should run on older Windows installs as well, but have not been tested. If you do test, please edit and update this page to indicate as such. ## Mac OS X ### Using Homebrew If you have a popular [brew](http://brew.sh/) tool installed, you can just do: ``` brew install haskell-stack ``` * The Homebrew formula and bottles lag slightly behind new Stack releases, but tend to be updated within a day or two. * At later stage, running `stack setup` might fail with `configure: error: cannot run C compiled programs.` in which case you should run `xcode-select --install`. * Normally, Homebrew will install from a pre-built binary (aka "pour from a bottle"), but if `brew` starts trying to build everything from source (which will take hours), see [their FAQ on the topic](https://github.com/Homebrew/homebrew/blob/master/share/doc/homebrew/FAQ.md#why-do-you-compile-everything). ### Manual download * Download the latest release: * [Mac OS X 64-bit](https://www.stackage.org/stack/osx-x86_64) * Extract the archive and place `stack` somewhere on your `$PATH` (see [Path section below](#path)) * Now you can run `stack` from the terminal. We generally test on the current version of Mac OS X, but stack is known to work on Yosemite and Mavericks as well, and may also work on older versions (YMMV). ### Notes If you are on OS X 10.11 ("El Capitan") and encounter either of these problems, see the linked FAQ entries: * [GHC 7.8.4 fails with `/usr/bin/ar: permission denied`](faq.md#usr-bin-ar-permission-denied) * [DYLD_LIBRARY_PATH is ignored](faq.md#dyld-library-path-ignored) ## Ubuntu *note*: for 32-bit, use the [generic Linux option](#linux) 1. Get the FP Complete key: sudo apt-key adv --keyserver hkp://keyserver.ubuntu.com:80 --recv-keys 575159689BEFB442 2. Add the appropriate source repository (if not sure, run ``lsb_release -a`` to find out your Ubuntu version): * Ubuntu 16.04 (amd64): echo 'deb http://download.fpcomplete.com/ubuntu xenial main'|sudo tee /etc/apt/sources.list.d/fpco.list * Ubuntu 15.10 (amd64): echo 'deb http://download.fpcomplete.com/ubuntu wily main'|sudo tee /etc/apt/sources.list.d/fpco.list * Ubuntu 14.04 (amd64) echo 'deb http://download.fpcomplete.com/ubuntu trusty main'|sudo tee /etc/apt/sources.list.d/fpco.list * Ubuntu 12.04 (amd64) echo 'deb http://download.fpcomplete.com/ubuntu precise main'|sudo tee /etc/apt/sources.list.d/fpco.list 3. Update apt and install sudo apt-get update && sudo apt-get install stack -y ## Debian *note*: for 32-bit, use the [generic Linux option](#linux) 1. Get the FP Complete key: sudo apt-key adv --keyserver hkp://keyserver.ubuntu.com:80 --recv-keys 575159689BEFB442 2. Add the appropriate source repository: * Debian 8 (amd64): echo 'deb http://download.fpcomplete.com/debian jessie main'|sudo tee /etc/apt/sources.list.d/fpco.list * Debian 7 (amd64) echo 'deb http://download.fpcomplete.com/debian wheezy main'|sudo tee /etc/apt/sources.list.d/fpco.list For unstable Debian distributions, the package from the most recent stable release will usually work. If it doesn't, please [report it](https://github.com/commercialhaskell/stack/issues/new). 3. Update apt and install sudo apt-get update && sudo apt-get install stack -y ## CentOS / Red Hat / Amazon Linux *note*: for 32-bit, use the [generic Linux option](#linux) 1. Add the appropriate source repository: * CentOS 7 / RHEL 7 (x86_64) curl -sSL https://s3.amazonaws.com/download.fpcomplete.com/centos/7/fpco.repo | sudo tee /etc/yum.repos.d/fpco.repo * CentOS 6 / RHEL 6 (x86_64) curl -sSL https://s3.amazonaws.com/download.fpcomplete.com/centos/6/fpco.repo | sudo tee /etc/yum.repos.d/fpco.repo 2. Install: sudo yum -y install stack ## Fedora *Note*: for 32-bit, you can use this [Fedora Copr repo](https://copr.fedoraproject.org/coprs/petersen/stack/) (not managed by the Stack release team, so not guaranteed to have the very latest version) which can be enabled with: `sudo dnf copr enable petersen/stack` 1. Add the appropriate source repository: * Fedora 23 (x86_64) curl -sSL https://s3.amazonaws.com/download.fpcomplete.com/fedora/23/fpco.repo | sudo tee /etc/yum.repos.d/fpco.repo * Fedora 22 (x86_64) curl -sSL https://s3.amazonaws.com/download.fpcomplete.com/fedora/22/fpco.repo | sudo tee /etc/yum.repos.d/fpco.repo 2. Install: sudo dnf -y install stack ## openSUSE / SUSE Linux Enterprise *Note:* openSUSE's and SLE's `stack` package isn't managed by the Stack release team, and since it is based on the version in Stackage LTS, and may lag new releases by ten days or more. 1. Add the appropriate OBS repository: * openSUSE Tumbleweed all needed is in distribution * openSUSE Leap sudo zypper ar http://download.opensuse.org/repositories/devel:/languages:/haskell/openSUSE_Leap_42.1/devel:languages:haskell.repo * SUSE Linux Enterprise 12 sudo zypper ar http://download.opensuse.org/repositories/devel:/languages:/haskell/SLE_12/devel:languages:haskell.repo 2. Install: sudo zypper in stack ## Arch Linux *Note:* `stack` package in the [community] repository isn't managed by the Stack release team. Depending on the maintainer's availability, it can lag new releases by some days. - [stack](https://www.archlinux.org/packages/community/x86_64/stack/) _latest stable version_ - [haskell-stack-git](https://aur.archlinux.org/packages/haskell-stack-git/) _git version_ In order to install stack from Hackage or from source, you will need the [libtinfo-5](https://aur.archlinux.org/packages/libtinfo-5/) Arch Linux package installed. If this package is not installed, stack will not be able to install GHC. If you use the [ArchHaskell repository](https://wiki.archlinux.org/index.php/ArchHaskell), you can also get the `haskell-stack-tool` package from there. ## NixOS Users who follow the `nixos-unstable` channel or the Nixpkgs `master` branch can install the latest `stack` release into their profile by running: nix-env -f "" -iA haskellPackages.stack Alternatively, the package can be built from source as follows. 1. Clone the git repo: git clone https://github.com/commercialhaskell/stack.git 2. Create a `shell.nix` file: cabal2nix --shell ./. --no-check --no-haddock > shell.nix Note that the tests fail on NixOS, so disable them with `--no-check`. Also, haddock currently doesn't work for stack, so `--no-haddock` disables it. 3. Install stack to your user profile: nix-env -i -f shell.nix For more information on using Stack together with Nix, please see [the NixOS manual section on Stack](http://nixos.org/nixpkgs/manual/#using-stack-together-with-nix). ## Linux (64-bit and 32-bit options available) * Download the latest release: * [Linux 64-bit, standard](https://www.stackage.org/stack/linux-x86_64) * [Linux 32-bit, standard](https://www.stackage.org/stack/linux-i386) If you are on an older distribution that only includes libgmp4 (libgmp.so.3), such as CentOS/RHEL/Amazon Linux 6.x, use one of these instead: * [Linux 64-bit, libgmp4](https://www.stackage.org/stack/linux-x86_64-gmp4) * [Linux 32-bit, libgmp4](https://www.stackage.org/stack/linux-i386-gmp4) * Extract the archive and place `stack` somewhere on your `$PATH` (see [Path section below](#path)) * Now you can run `stack` from the terminal. Tested on Fedora 20: make sure to install the following packages `sudo yum install perl make automake gcc gmp-devel`. For Gentoo users, make sure to have the `ncurses` package with `USE=tinfo` (without it, stack will not be able to install GHC). ## FreeBSD (only 64-bit currently available, tested on FreeBSD 10.3-RELEASE) * Install required dependencies: pkg install devel/gmake perl5 lang/gcc misc/compat8x misc/compat9x converters/libiconv ca_root_nss * Download the latest release: * [FreeBSD 64-bit](https://www.stackage.org/stack/freebsd-x86_64) * Extract the archive and place `stack` somewhere on your `$PATH` (see [Path section below](#path)) * Now you can run `stack` from the terminal. An unofficial package repository for FreeBSD 10 (amd64 only) and install instructions are available at [http://stack-pkg.applicative.tech](http://stack-pkg.applicative.tech/). The repository is not official and as such might lag behind new releases. See [issue #1253](https://github.com/commercialhaskell/stack/issues/1253) for progress on official FreeBSD binaries. ## Path You can install stack by copying it anywhere on your PATH environment variable. We recommend installing in the same directory where stack itself will install executables (that way stack is able to upgrade itself!). On Windows, that directory is `%APPDATA%\local\bin`, e.g. "c:\Users\Michael\AppData\Roaming\local\bin". For other systems, use `$HOME/.local/bin`. If you don't have that directory in your PATH, you may need to update your PATH (such as by editing .bashrc). If you're curious about the choice of these paths, see [issue #153](https://github.com/commercialhaskell/stack/issues/153) ## Shell auto-completion To get tab-completion of commands on bash, just run the following (or add it to `.bashrc`): eval "$(stack --bash-completion-script stack)" For more information and other shells, see [the shell auto-completion page](shell_autocompletion.md) ## Upgrade There are essentially three different approaches to upgrade: * If you're using a package manager (e.g., the Ubuntu debs listed above) and are happy with sticking with the officially released binaries, simply follow your normal package manager strategies for upgrading (e.g. `apt-get update && apt-get upgrade`). * If you're not using a package manager but want to stick with the official binaries (such as on Windows or Mac), you'll need to manually follow the steps above to download the newest binaries from the release page and replace the old binary. * The `stack` tool itself ships with an `upgrade` command, which will build `stack` from source and install it to the default install path (see the previous section). You can use `stack upgrade` to get the latest official release, and `stack upgrade --git` to install from Git and live on the bleeding edge. If you follow this, make sure that this directory is on your `PATH` and takes precedence over the system installed `stack`. For more information, see [this discussion](https://github.com/commercialhaskell/stack/issues/237#issuecomment-126793301). stack-1.1.2/doc/MAINTAINER_GUIDE.md0000644000000000000000000001744412717707440014464 0ustar0000000000000000# Maintainer guide ## Pre-release steps * Ensure `release` and `stable` branches merged to `master` * Ensure integration tests pass on a representative Windows, Mac OS X, and Linux (Linux is handled by Jenkins automatically): `stack install --pedantic && stack test --pedantic --flag stack:integration-tests` . The actual release script will perform a more thorough test for every platform/variant prior to uploading, so this is just a pre-check * Ensure `stack haddock` works (Travis CI now does this) * Stack builds with `stack-7.8.yaml` (Travis CI now does this) * stack can build the wai repo * Running `stack build` a second time on either stack or wai is a no-op * Build something that depends on `happy` (suggestion: `hlint`), since `happy` has special logic for moving around the `dist` directory * In master branch: * stack.cabal: bump the version number to release (even third component) * ChangeLog: rename the "unreleased changes" section to the new version * Cut a release candidate branch `rc/vX.Y.Z` from master * In master branch: * stack.cabal: bump version number to unstable (odd third component) * Changelog: add new "unreleased changes" section * stack.yaml: bump to use latest LTS version, and check whether extra-deps still needed * In RC branch: * Update the ChangeLog ([this comparison](https://github.com/commercialhaskell/stack/compare/stable...master) is handy): * Check for any important changes that missed getting an entry in Changelog * Check for any entries that snuck into the previous version's changes due to merges * Review documentation for any changes that need to be made * Search for old Stack version, unstable stack version, and the next "obvious" version in sequence (if doing a non-obvious jump) and replace with new version * Look for any links to "latest" documentation, replace with version tag * Ensure all documentation pages listed in `mkdocs.yaml` * Check that any new Linux distribution versions added to `etc/scripts/release.hs` and `etc/scripts/vagrant-releases.sh` * [Ubuntu](https://wiki.ubuntu.com/Releases) * [Debian](https://www.debian.org/releases/) (keep at least latest two) * [CentOS](https://wiki.centos.org/Download) * [Fedora](https://fedoraproject.org/wiki/Releases) * Check for new FreeBSD release * Check that no new entries need to be added to [releases.yaml](https://github.com/fpco/stackage-content/blob/master/stack/releases.yaml), [install_and_upgrade.md](https://github.com/commercialhaskell/stack/blob/master/doc/install_and_upgrade.md), and `README.md` * Remove unsupported/obsolete distribution versions from [install_and_upgrade.md](https://github.com/commercialhaskell/stack/blob/master/doc/install_and_upgrade.md), and perhaps from the release process. ## Release process See [stack-release-script's README](https://github.com/commercialhaskell/stack/blob/master/etc/scripts/README.md#prerequisites) for requirements to perform the release, and more details about the tool. * Create a [new draft Github release](https://github.com/commercialhaskell/stack/releases/new) with tag and name `vX.Y.Z` (where X.Y.Z is the stack package's version), targetting the RC branch * On each machine you'll be releasing from, set environment variables: `GITHUB_AUTHORIZATION_TOKEN`, `AWS_ACCESS_KEY_ID`, `AWS_SECRET_ACCESS_KEY`, `AWS_DEFAULT_REGION`. Note: since one of the tools (rpm-s3 on CentOS) doesn't support AWS temporary credentials, you can't use MFA with the AWS credentials (`AWS_SECURITY_TOKEN` is ignored). * On a machine with Vagrant installed: * Run `etc/scripts/vagrant-releases.sh` * On Mac OS X: * Run `etc/scripts/osx-release.sh` * On Windows: * Ensure your working tree is in `C:\stack` (or a similarly short path) * Run `etc\scripts\windows-releases.bat` * Release Windows installers. See [stack-installer README](https://github.com/borsboom/stack-installer#readme) * Publish Github release * Upload package to Hackage: `stack upload . --pvp-bounds=both` * On a machine with Vagrant installed: * Run `etc/scripts/vagrant-distros.sh` * Edit [stack-setup-2.yaml](https://github.com/fpco/stackage-content/blob/master/stack/stack-setup-2.yaml), and add the new linux64 stack bindist * Activate version for new release tag on [readthedocs.org](https://readthedocs.org/projects/stack/versions/), and ensure that stable documentation has updated * Submit a PR for the [haskell-stack Homebrew formula](https://github.com/Homebrew/homebrew-core/blob/master/Formula/haskell-stack.rb) * Be sure to update the SHA sum * The commit message should just be `haskell-stack ` * [Flag the Arch Linux package as out-of-date](https://www.archlinux.org/packages/community/x86_64/stack/flag/) * Push signed Git tag, matching Github release tag name, e.g.: `git tag -u 0x575159689BEFB442 vX.Y.Z && git push origin vX.Y.Z` * Reset the `release` branch to the released commit, e.g.: `git checkout release && git merge --ff-only vX.Y.Z && git push origin release` * Update the `stable` branch similarly * Delete the RC branch (locally and on origin) * Upload haddocks to Hackage: `etc/scripts/upload-haddocks.sh` * Merge any changes made in the RC/release/stable branches to master. * Announce to haskell-cafe@haskell.org haskell-stack@googlegroups.com commercialhaskell@googlegroups.com mailing lists * Keep an eye on the [Hackage matrix builder](http://matrix.hackage.haskell.org/package/stack) ## Setting up a Windows VM for releases These instructions are a bit rough, but has the steps to get the Windows machine set up. 1. Download VM image: https://developer.microsoft.com/en-us/microsoft-edge/tools/vms/mac/ 2. Launch the VM using Virtualbox and the image downloaded 3. Adjust settings: * Number of CPUs: match the host * Memory: at least 3 GB * Video RAM: the minimum recommended by Virtualbox * Enable 3D and 2D accelerated mode * Enabled shared clipboard (both directions) 4. Install the VMware guest additions, and reboot 5. Configure a shared folder for your home directory on the host, and mount it on Z: 6. Install Windows SDK (for signtool): http://microsoft.com/en-us/download/confirmation.aspx?id=8279 7. Install msysgit: https://msysgit.github.io/ 8. Install nsis-2.46.5-Unicode-setup.exe from http://www.scratchpaper.com/ 9: Install Stack using the Windows 64-bit installer 10. Visit https://hackage.haskell.org/ in Edge to ensure system has correct CA certificates 11. Get the object code certificate from [password-store](https://github.com/fpco/password-store), in `certificates/code_signing/fpcomplete_corporation_startssl_2015-09-22.pfx`. Double click it in explorer and import it 12. Run in command prompt: md C:\p md C:\p\tmp cd \p md c:\tmp 13. Create `C:\p\env.bat`: SET STACK_ROOT=C:\p\.sr SET TEMP=C:\p\tmp SET TMP=C:\p\tmp SET PATH=C:\Users\IEUser\AppData\Roaming\local\bin;"c:\Program Files\Git\usr\bin";"C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin";%PATH% 14. Run `C:\p\env.bat` (do this every time you open a new command prompt) 15. Import the `dev@fpcomplete.com` (0x575159689BEFB442) GPG secret key 16. Run in command prompt (adjust the `user.email` and `user.name` settings): stack setup stack install cabal-install md %HOMEPATH%\.ssh copy z:\.ssh\id_rsa %HOMEPATH%\.ssh git config --global user.email manny@fpcomplete.com git config --global user.name "Emanuel Borsboom" git config --global push.default simple git clone git@github.com:commercialhaskell/stack.git git clone git@github.com:borsboom/stack-installer.git stack-1.1.2/doc/nix_integration.md0000644000000000000000000002000212711161622015267 0ustar0000000000000000# Nix integration (since 0.1.10.0) When using the Nix integration, Haskell dependencies are handled as usual: they are downloaded from Stackage and build locally by Stack. Nix is used by Stack to provide the _non-Haskell_ dependencies needed by these Haskell packages. `stack` can automatically create a build environment (the equivalent of a "container" in Docker parlance) using `nix-shell`, provided Nix is already installed on your system. To do so, please visit the [Nix download page](http://nixos.org/nix/download.html). There are two ways to create a build environment: - providing a list of packages (by "attribute name") from [Nixpkgs](http://nixos.org/nixos/packages.html), or - providing a custom `shell.nix` file containing a Nix expression that determines a *derivation*, i.e. a specification of what resources are available inside the shell. The second requires writing code in Nix's custom language. So use this option only if you already know Nix and have special requirements, such as using custom Nix packages that override the standard ones or using system libraries with special requirements. ### Additions to your `stack.yaml` Add a section to your `stack.yaml` as follows: ```yaml nix: enable: true packages: [glpk, pcre] ``` This will instruct `stack` to build inside a local build environment that will have the `glpk` and `pcre` libraries installed and available. Further, the build environment will implicitly also include a version of GHC matching the configured resolver. Enabling Nix support means packages will always be built using a GHC available inside the shell, rather than your globally installed one if any. Note that in this mode `stack` can use only those resolvers that have already been mirrored into the Nix package repository. The [Nixpkgs master branch](https://github.com/NixOS/nixpkgs/tree/master/pkgs/development/haskell-modules) usually picks up new resolvers such as Stackage nightlies and LTS versions within two or three days. Then it takes another two or three days before those updates arrive in the `unstable` channel. Release channels, like `nixos-15.09`, receive those updates only occasionally -- say, every two or three months --, so you should not expect them to have the latest resolvers available. Fresh Nix installs use a release version by default. To know for sure whether a given resolver as available on your system, you can use the command ```sh $ nix-env -f "" -qaP -A haskell.packages.lts-3_13.ghc haskell.packages.lts-3_13.ghc ghc-7.10.2 ``` to check whether it's available. If Nix doesn't know that resolver yet, then you'll see the following error message instead: ```sh $ nix-env -f "" -qaP -A haskell.packages.lts-3_99.ghc error: attribute ‘lts-3_99’ in selection path ‘haskell.packages.lts-3_99.ghc’ not found ``` You can list all known Haskell package sets in Nix with the following: ```sh $ nix-instantiate --eval -E "with import {}; lib.attrNames haskell.packages" ``` Alternatively, install `nix-repl`, a convenient tool to explore nixpkgs: ```sh $ nix-env -i nix-repl $ nix-repl ``` In the REPL, load nixpkgs and get the same information through autocomplete: ```sh nix-repl> :l nix-repl> haskell.packages.lts- ``` You can type and evaluate any nix expression in the nix-repl, such as the one we gave to `nix-instantiate` earlier. **Note:** currently, stack only discovers dynamic and static libraries in the `lib/` folder of any nix package, and likewise header files in the `include/` folder. If you're dealing with a package that doesn't follow this standard layout, you'll have to deal with that using a custom shell file (see below). ### Use stack as normal With Nix enabled, `stack build` and `stack exec` will automatically launch themselves in a local build environment (using `nix-shell` behind the scenes). If `enable:` is omitted or set to `false`, you can still build in a nix-shell by passing the `--nix` flag to stack, for instance `stack --nix build`. Passing any `--nix*` option to the command line will do the same. **Known limitation on OS X:** currently, `stack --nix ghci` fails on OS X, due to a bug in GHCi when working with external shared libraries. ### The Nix shell By default, stack will run the build in a pure Nix build environment (or *shell*), which means the build should fail if you haven't specified all the dependencies in the `packages:` section of the `stack.yaml` file, even if these dependencies are installed elsewhere on your system. This behaviour enforces a complete description of the build environment to facilitate reproducibility. To override this behaviour, add `pure: false` to your `stack.yaml` or pass the `--no-nix-pure` option to the command line. **Note:** On OS X shells are non-pure by default currently. This is due soon to be resolved locale issues. So on OS X you'll need to be a bit more careful to check that you really have listed all dependencies. ### Package sources By default, `nix-shell` will look for the nixpkgs package set located by your `NIX_PATH` environment variable. You can override this by passing `--nix-path="nixpkgs=/my/own/nixpkgs/clone"` to ask Nix to use your own local checkout of the nixpkgs repository. You could in this way use a bleeding edge nixpkgs, cloned from the [nixpkgs](http://www.github.com/NixOS/nixpkgs) `master` branch, or edit the nix descriptions of some packages. Setting ```yml nix: path: [nixpkgs=/my/own/nixpkgs/clone] ``` in your `stack.yaml` will do the same. ## Command-line options The configuration present in your `stack.yaml` can be overridden on the command-line. See `stack --nix-help` for a list of all Nix options. ## Configuration `stack.yaml` contains a `nix:` section with Nix settings. Without this section, Nix will not be used. Here is a commented configuration file, showing the default values: ```yaml nix: # false by default. Must be present and set to `true` to enable Nix. # You can set set it in your `$HOME/.stack/config.yaml` to enable # Nix for all your projects without having to repeat it # enable: true # true by default. Tells Nix whether to run in a pure shell or not. pure: true # Empty by default. The list of packages you want to be # available in the nix-shell at build time (with `stack # build`) and run time (with `stack exec`). packages: [] # Unset by default. You cannot set this option if `packages:` # is already present and not empty. shell-file: shell.nix # A list of strings, empty by default. Additional options that # will be passed verbatim to the `nix-shell` command. nix-shell-options: [] # A list of strings, empty by default, such as # `[nixpkgs=/my/local/nixpkgs/clone]` that will be used to override # NIX_PATH. path: [] ``` ## Using a custom shell.nix file Nix is also a programming language, and as specified [here](#nix-integration) if you know it you can provide to the shell a fully customized derivation as an environment to use. Here is the equivalent of the configuration used in [this section](#additions-to-your-stackyaml), but with an explicit `shell.nix` file (make sure you're using a nixpkgs version later than 2015-03-05): ```nix with (import {}); haskell.lib.buildStackProject { name = "myEnv"; buildInputs = [ glpk pcre ]; } ``` Defining manually a `shell.nix` file gives you the possibility to override some Nix derivations ("packages"), for instance to change some build options of the libraries you use, or to set additional environment variables. See the [Nix manual][nix-manual-exprs] for more. The `buildStackProject` utility function is documented in the [Nixpkgs manual][nixpkgs-manual-haskell]. And now for the `stack.yaml` file: ```yaml nix: enable: true shell-file: shell.nix ``` The `stack build` command will behave exactly the same as above. Note that specifying both `packages:` and a `shell-file:` results in an error. (Comment one out before adding the other.) [nix-manual-exprs]: http://nixos.org/nix/manual/#chap-writing-nix-expressions [nixpkgs-manual-haskell]: https://nixos.org/nixpkgs/manual/#users-guide-to-the-haskell-infrastructure stack-1.1.2/doc/nonstandard_project_init.md0000644000000000000000000001146512663440162017174 0ustar0000000000000000# Non-standard project initialization ## Introduction The purpose of this page is to collect information about issues that arise when users either have an existing cabal project or another nonstandard setup such as a private hackage database. ## Using a Cabal File New users may be confused by the fact that you must add dependencies to the package's cabal file, even in the case when you have already listed the package in the `stack.yaml`. In most cases, dependencies for your package that are in the Stackage snapshot need *only* be added to the cabal file. stack makes heavy use of Cabal the library under the hood. In general, your stack packages should also end up being valid cabal-install packages. ### Issues Referenced - https://github.com/commercialhaskell/stack/issues/105 ## Passing Flags to Cabal Any build command, `bench`, `install`, `haddock`, `test`, etc. takes a `--flag` option which passes flags to cabal. Another way to do this is using the flags field in a `stack.yaml`, with the option to specify flags on a per package basis. As an example, in a `stack.yaml` for multi-package project with packages `foo`, `bar`, `baz`: ``` flags: foo: release: true bar: default: true baz: manual: true ``` It is also possible to pass the same flag to multiple packages, i.e. `stack build --flag *:necessary` Currently one needs to list all of your modules that interpret flags in the `other-modules` section of a cabal file. `cabal-install` has a different behavior currently and doesn't require that the modules be listed. This may change in a future release. ### Issues Referenced - https://github.com/commercialhaskell/stack/issues/191 - https://github.com/commercialhaskell/stack/issues/417 - https://github.com/commercialhaskell/stack/issues/335 - https://github.com/commercialhaskell/stack/issues/301 - https://github.com/commercialhaskell/stack/issues/365 - https://github.com/commercialhaskell/stack/issues/105 ## Selecting a Resolver `stack init` or `stack new` will try to default to the current Haskell LTS present on `https://www.stackage.org/snapshots` if no snapshot has been previously used locally, and to the latest LTS snapshot locally used for a build otherwise. Using an incorrect resolver can cause a build to fail if the version of GHC it requires is not present. In order to override the resolver entry at project initialization one can pass `--prefer-lts` or `--prefer-nightly`. These options will choose the latest LTS or nightly versions locally used. Alternatively the `--resolver` option can be used with the name of any snapshots on Stackage, or with `lts` or `nightly` to select the latest versions, disregarding previously used ones. This is not the default so as to avoid unnecessary recompilation time. :TODO: Document `--solver` ### Issues Referenced - https://github.com/commercialhaskell/stack/issues/468 - https://github.com/commercialhaskell/stack/issues/464 ## Using git Repositories stack has support for packages that reside in remote git locations. Example: ``` packages: - '.' - location: git: https://github.com/kolmodin/binary commit: 8debedd3fcb6525ac0d7de2dd49217dce2abc0d9 ``` ### Issues Referenced - https://github.com/commercialhaskell/stack/issues/254 - https://github.com/commercialhaskell/stack/issues/199 ## Private Hackage Working with a private Hackage is currently supported in certain situations. There exist special entries in `stack.yaml` that may help you. In a `stack.yaml` file, it is possible to add lines for packages in your database referencing the sdist locations via an `http` entry, or to use a `Hackage` entry. The recommended stack workflow is to use git submodules instead of a private Hackage. Either by using git submodules and listing the directories in the packages section of `stack.yaml`, or by adding the private dependencies as git URIs with a commit SHA to the `stack.yaml`. This has the large benefit of eliminating the need to manage a Hackage database and pointless version bumps. For further information see [YAML configuration](yaml_configuration.md) ### Issues Referenced - https://github.com/commercialhaskell/stack/issues/445 - https://github.com/commercialhaskell/stack/issues/565 ## Custom Snapshots Currently WIP? ### Issues Referenced - https://github.com/commercialhaskell/stack/issues/111 - https://github.com/commercialhaskell/stack/issues/253 - https://github.com/commercialhaskell/stack/issues/137 ## Intra-package Targets stack supports intra-package targets, similar to `cabal build COMPONENTS` for situations when you don't want to build every target inside your package. Example: ``` stack build stack:lib:stack stack test stack:test:stack-integration-test ``` Note: this does require prefixing the component name with the package name. ### Issues referenced - https://github.com/commercialhaskell/stack/issues/201 stack-1.1.2/doc/README.md0000644000000000000000000001332212717707440013044 0ustar0000000000000000# The Haskell Tool Stack Stack is a cross-platform program for developing Haskell projects. It is aimed at Haskellers both new and experienced. It features: * Installing GHC automatically, in an isolated location. * Installing packages needed for your project. * Building your project. * Testing your project. * Benchmarking your project. #### How to install Downloads are available by operating system: * [Windows](install_and_upgrade.md#windows) * [Mac OS X](install_and_upgrade.md#mac-os-x) * [Ubuntu](install_and_upgrade.md#ubuntu) * [Debian](install_and_upgrade.md#debian) * [CentOS / Red Hat / Amazon Linux](install_and_upgrade.md#centos) * [Fedora](install_and_upgrade.md#fedora) * [openSUSE / SUSE Linux Enterprise](install_and_upgrade.md#suse) * [Arch Linux](install_and_upgrade.md#arch-linux) * [NixOS](install_and_upgrade.md#nixos) * [Linux (general)](install_and_upgrade.md#linux) * [FreeBSD](install_and_upgrade.md#freebsd) [Upgrade instructions](install_and_upgrade.md#upgrade) Note: if you are using cabal-install to install stack, you may need to pass a constraint to work around a [Cabal issue](https://github.com/haskell/cabal/issues/2759): `cabal install --constraint 'mono-traversable >= 0.9' stack`. #### Quick Start Guide First you need to [install it (see previous section)](#how-to-install). ##### Start your new project: ```bash stack new my-project cd my-project stack setup stack build stack exec my-project-exe ``` - The `stack new` command will create a new directory containing all the needed files to start a project correctly. - The `stack setup` will download the compiler if necessary in an isolated location (default `~/.stack`) that won't interfere with any system-level installations. (For information on installation paths, please use the `stack path` command.). - The `stack build` command will build the minimal project. - `stack exec my-project-exe` will execute the command. - If you just want to install an executable using stack, then all you have to do is`stack install `. If you want to launch a REPL: ```bash stack ghci ``` Run `stack` for a complete list of commands. ##### Workflow The `stack new` command should have created the following files: ``` . ├── LICENSE ├── Setup.hs ├── app │   └── Main.hs ├── my-project.cabal ├── src │   └── Lib.hs ├── stack.yaml └── test └── Spec.hs 3 directories, 7 files ``` So to manage your library: 1. Edit files in the `src/` directory. The `app` directory should preferably contain only files related to executables. 2. If you need to include another library (for example the package [`text`](https://hackage.haskell.org/package/text): - Add the package `text` to the file `my-project.cabal` in the section `build-depends: ...`. - run `stack build` another time 3. If you get an error that tells you your package isn't in the LTS. Just try to add a new version in the `stack.yaml` file in the `extra-deps` section. It was a really fast introduction on how to start to code in Haskell using `stack`. If you want to go further, we highly recommend you to read the [`stack` guide](GUIDE.md). #### How to contribute This assumes that you have already installed a version of stack, and have `git` installed. 1. Clone `stack` from git with `git clone https://github.com/commercialhaskell/stack.git`. 2. Enter into the stack folder with `cd stack`. 3. Build `stack` using a pre-existing `stack` install with `stack setup && stack build`. 4. Once `stack` finishes building, check the stack version with `stack exec stack -- --version`. Make sure the version is the latest. 5. Look for issues tagged with [`newcomer` and `awaiting-pr` labels](https://github.com/commercialhaskell/stack/issues?q=is%3Aopen+is%3Aissue+label%3Anewcomer+label%3A%22awaiting+pr%22). Build from source as a one-liner: ```bash git clone https://github.com/commercialhaskell/stack.git && \ cd stack && \ stack setup && \ stack build ``` #### Complete guide to stack This repository also contains a complete [user guide to using stack ](GUIDE.md), covering all of the most common use cases. #### Questions, Feedback, Discussion * For frequently asked questions about detailed or specific use-cases, please see [the FAQ](faq.md). * For general questions, comments, feedback and support please write to [the stack mailing list](https://groups.google.com/d/forum/haskell-stack). * For bugs, issues, or requests please [open an issue](https://github.com/commercialhaskell/stack/issues/new). * When using Stack Overflow, please use [the haskell-stack tag](http://stackoverflow.com/questions/tagged/haskell-stack). #### Why stack? stack is a project of the [Commercial Haskell](http://commercialhaskell.com/) group, spearheaded by [FP Complete](https://www.fpcomplete.com/). It is designed to answer the needs of commercial Haskell users, hobbyist Haskellers, and individuals and companies thinking about starting to use Haskell. It is intended to be easy to use for newcomers, while providing the customizability and power experienced developers need. While stack itself has been around since June of 2015, it is based on codebases used by FP Complete for its corporate customers and internally for years prior. stack is a refresh of that codebase combined with other open source efforts like [stackage-cli](https://github.com/fpco/stackage-cli) to meet the needs of users everywhere. A large impetus for the work on stack was a [large survey of people interested in Haskell](https://www.fpcomplete.com/blog/2015/05/thousand-user-haskell-survey), which rated build issues as a major concern. The stack team hopes that stack can address these concerns. stack-1.1.2/doc/shell_autocompletion.md0000644000000000000000000000316512644245454016345 0ustar0000000000000000# Shell Auto-completion Note: if you installed a package for you Linux distribution, the bash completion file was automatically installed (you may need the `bash-completion` package to have it take effect). The following adds support for shell tab completion for standard Stack arguments, although completion for filenames and executables etc. within stack is still lacking (see [issue 823](https://github.com/commercialhaskell/stack/issues/832)). ## for bash users you need to run following command ``` eval "$(stack --bash-completion-script stack)" ``` You can also add it to your `.bashrc` file if you want. ## for ZSH users documentation says: > Zsh can handle bash completions functions. The latest development version of zsh has a function bashcompinit, that when run will allow zsh to read bash completion specifications and functions. This is documented in the zshcompsys man page. To use it all **you need to do is run bashcompinit at any time after compinit**. It will define complete and compgen functions corresponding to the bash builtins. You must so: 1. launch compinint 2. launch bashcompinit 3. eval stack bash completion script ```shell autoload -U +X compinit && compinit autoload -U +X bashcompinit && bashcompinit eval "$(stack --bash-completion-script stack)" ``` :information_source: If you already have quite a large zshrc, or if you use oh-my-zsh, **compinit** will probably already be loaded. If you have a blank zsh config, all of the 3 lines above are necessary. :gem: tip: instead of running those 3 lines from your shell every time you want to use stack, you can add those 3 lines in your $HOME/.zshrc file stack-1.1.2/doc/SIGNING_KEY.md0000644000000000000000000000333512630674604013717 0ustar0000000000000000# Signing key Releases are signed with this key: ``` -----BEGIN PGP PUBLIC KEY BLOCK----- Version: GnuPG v1 mQENBFVs+cMBCAC5IsLWTikd1V70Ur1FPJMn14Sc/C2fbXc0zRcPuWX+JaXgrIJQ 74A3UGBpa07wJDZiQLLz4AasDQj++9gXdiM9MlK/xWt8BQpgQqSMgkktFVajSWX2 rSXPjqLtsl5dLsc8ziBkd/AARXoeITmXX+n6oRTy6QfdMv2Tacnq7r9M9J6bAz6/ 7UsKkyZVwsbUPea4SuD/s7jkXAuly15APaYDmF5mMlpoRWp442lJFpA0h52mREX1 s5FDbuKRQW7OpZdLcmOgoknJBDSpKHuHEoUhdG7Y3WDUGYFZcTtta1qSVHrm3nYa 7q5yOzPW4/VpftkBs1KzIxx0nQ5INT5W5+oTABEBAAG0H0ZQQ29tcGxldGUgPGRl dkBmcGNvbXBsZXRlLmNvbT6JATcEEwEKACEFAlVs+cMCGwMFCwkIBwMFFQoJCAsF FgMCAQACHgECF4AACgkQV1FZaJvvtEIP8gf/S/k4C3lp/BFb0K9DHHSt6EaGQPwy g+O8d+JvL7ghkvMjlQ+UxDw+LfRKANTpl8a4vHtEQLHEy1tPJfrnMA8DNci8HLVx rK3lIqMfv5t85VST9rz3X8huSw7qwFyxsmIqFtJC/BBQfsOXC+Q5Z2nbResXHMeA 5ZvDopZnqKPdmMOngabPGZd89hOKn6r8k7+yvZ/mXmrGOB8q5ZGbOXUbCshst7lc yZWmoK3VJdErQjGHCdF4MC9KFBQsYYUy9b1q0OUv9QLtq/TeKxfpvYk9zMWAoafk M8QBE/qqOpqkBRoKbQHCDQgx7AXJMKnOA0jPx1At57hWl7PuEH4rK38UtLkBDQRV bPnDAQgAx1+4ENyaMk8XznQQ4l+nl8qw4UedZhnR5Xxr6z2kcMO/0VdwmIDCpxaM spurOF+yExfY/Chbex7fThWTwVgfsItUc/QLLv9jkvpveMUDuPyh/4QrAQBYoW09 jMJcOTFQU+f4CtKaN/1PNoTSU2YkVpbhvtV3Jn2LPFjUSPb7z2NZ9NKe10M0/yN+ l0CuPlqu6GZR5L3pA5i8PZ0Nh47j0Ux5KIjrjCGne4p+J8qqeRhUf04yHAYfDLgE aLAG4v4pYbb1jNPUm1Kbk0lo2c3dxx0IU201uAQ6LNLdF/WW/ZF7w3iHn7kbbzXO jhbq2rvZEn3K9xDr7homVnnj21/LSQARAQABiQEfBBgBCgAJBQJVbPnDAhsMAAoJ EFdRWWib77RC3ukH/R9jQ4q6LpXynQPJJ9QKwstglKfoKNpGeAYVTEn0e7NB0HV5 BC+Da5SzBowboxC2YCD1wTAjBjLLQfAYNyR+tHpJBaBmruafj87nBCDhSWwWDXwx OUDpNOwKUkrwZDRlM7n4byoMRl7Vh/7CXxaTqkyao1c5v3mHh/DremiTvOJ4OXgJ 77NHaPXezHkCFZC8/sX6aY0DJxF+LIE84CoLI1LYBatH+NKxoICKA+yeF3RIVw0/ F3mtEFEtmJ6ljSks5tECxfJFvQlkpILBbGvHfuljKMeaj+iN+bsHmV4em/ELB1ku N9Obs/bFDBMmQklIdLP7dOunDjY4FwwcFcXdNyg= =YUsC -----END PGP PUBLIC KEY BLOCK----- ``` stack-1.1.2/doc/travis_ci.md0000644000000000000000000001047612663440162014074 0ustar0000000000000000# Travis CI For many use cases, the [Travis caching section of the user guide](GUIDE.md#travis-with-caching) will be sufficient. This page documents how to use Stack on [Travis CI](https://travis-ci.org/). We assume you have basic familiarity with Travis. *Note:* both Travis and Stack infrastructures are actively developed. We try to document best practices at the moment. ## Container infrastructure For Stack on Travis to be practical, we must use caching. Otherwise build times will take an incredibly long time, about 30 minutes versus 3-5. Caching is currently available only for [container-based Travis infrastructure](http://docs.travis-ci.com/user/workers/container-based-infrastructure/). Shortly we have to add ```yaml sudo: false # Caching so the next build will be fast too. cache: directories: - $HOME/.stack ``` To the `.travis.yml`. This however restricts how we can install GHC and Stack on the Travis machines. ## Installing Stack Currently there is only one reasonable way to install Stack: fetch precompiled binary from the Github. ```yaml before_install: # Download and unpack the stack executable - mkdir -p ~/.local/bin - export PATH=$HOME/.local/bin:$PATH - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' ``` Once Travis whitelists the stack .deb files, we'll be able to simply include stack in the `addons` section, and automatically use the newest version of stack, avoiding that complicated `before_install` section This is being tracked in the [apt-source-whitelist](https://github.com/travis-ci/apt-source-whitelist/pull/7) and [apt-package-whitelist](https://github.com/travis-ci/apt-package-whitelist/issues/379) issue trackers. ## Installing GHC There are two ways to install GHC: - Let Stack download GHC - Install GHC using [apt plugin](http://docs.travis-ci.com/user/apt/) See the [Travis caching section of the user guide](GUIDE.md#travis-with-caching) for an example of the first option (letting Stack download GHC). Here, we will explain the second option. With single GHC the situation is simple: ```yaml before_install: - export PATH=/opt/ghc/7.10.2/bin:$PATH addons: apt: sources: - hvr-ghc packages: - ghc-7.10.2 ``` ### Multiple GHC - parametrised builds Travis apt plugin doesn't yet support installing apt packages dynamically (https://github.com/travis-ci/travis-ci/issues/4291). That for we need to write a bit repetitive `.travis.yml`. Also for different GHC versions, you probably want to use different `stack.yaml` files. ```yaml # N.B. No top-level env: declaration! matrix: include: - env: GHCVER=7.8.4 STACK_YAML=stack.yaml addons: apt: sources: - hvr-ghc packages: - ghc-7.8.4 - env: GHCVER=7.10.1 STACK_YAML=stack-7.10.yaml addons: apt: sources: - hvr-ghc packages: - ghc-7.10.1 - env: GHCVER=head STACK_YAML=stack-head.yaml addons: apt: sources: - hvr-ghc packages: - ghc-head allow_failures: - env: GHCVER=head STACK_YAML=stack-head.yaml before_install: # ghc - export PATH=/opt/ghc/$GHCVER/bin:$PATH ``` Especially to use ghc `HEAD` you need to pass `--skip-ghc-check` option to Stack. ## Running tests After the environment setup, actual test running is simple: ```yaml script: - stack --no-terminal --skip-ghc-check test ``` ## Other details Some Stack commands will run for long time (when cache is cold) without producing any output. For Travis not to timeout, one can wrap commands in [a simple script](https://github.com/futurice/fum2github/blob/master/travis_long). ```yaml install: - ./travis_long stack --no-terminal --skip-ghc-check setup - ./travis_long stack --no-terminal --skip-ghc-check test --only-snapshot ``` ## Examples - [futurice/fum2github](https://github.com/futurice/fum2github/blob/master/.travis.yml) - [haskell-distributed/cloud-haskell](https://github.com/haskell-distributed/cloud-haskell/blob/master/.travis.yml) - [simonmichael/hledger](https://github.com/simonmichael/hledger/blob/master/.travis.yml) - [fpco/wai-middleware-crowd](https://github.com/fpco/wai-middleware-crowd/blob/master/.travis.yml) - [commercialhaskell/all-cabal-hashes-tool](https://github.com/commercialhaskell/all-cabal-hashes-tool/blob/master/.travis.yml) stack-1.1.2/doc/yaml_configuration.md0000644000000000000000000004454512701273661016007 0ustar0000000000000000# YAML Configuration This page is intended to fully document all configuration options available in the stack.yaml file. Note that this page is likely to be both *incomplete* and sometimes *inaccurate*. If you see such cases, please update the page, and if you're not sure how, open an issue labeled "question". The stack.yaml configuration options break down into [project specific](#project-config) options in: - `/stack.yaml` and [non-project specific](#non-project-config) options in: - `/etc/stack/config.yaml` -- for system global non-project default options - `~/.stack/config.yaml` -- for user non-project default options - The project file itself may also contain non-project specific options *Note:* When stack is invoked outside a stack project it will source project specific options from `~/.stack/global/stack.yaml`. Options in this file will be ignored for a project with its own `/stack.yaml`. ## Project config Project specific options are only valid in the `stack.yaml` file local to a project, not in the user or global config files. ### packages The `packages` section lists all local (project) packages. The term _local package_ should be differentiated from a _dependency package_. A local package is something that you are developing as part of the project. Whereas a dependency package is an external package that your project depends on. In its simplest usage, it will be a list of directories or HTTP(S) URLs to a tarball or a zip. For example: ```yaml packages: - . - dir1/dir2 - https://example.com/foo/bar/baz-0.0.2.tar.gz ``` Each package directory or location specified must have a valid cabal file present. Note that the subdirectories of the directory are not searched for cabal files. Subdirectories will have to be specified as independent items in the list of packages. When the `packages` field is not present, it defaults to looking for a package in the project's root directory: ```yaml packages: - . ``` #### Complex package locations (`location`) More complex package locations can be specified in a key-value format with `location` as a mandatory key. In addition to `location` some optional key-value pairs can be specified to include specific subdirectories or to specify package attributes as descibed later in this section. In its simplest form a `location` key can have a single value in the same way as described above for single value items. Alternativel it can have key-value pairs as subfields to describe a git or mercurial repository location. For example: ```yaml packages: - location: . - location: dir1/dir2 - location: https://example.com/foo/bar/baz-0.0.2.tar.gz - location: http://github.com/yesodweb/wai/archive/2f8a8e1b771829f4a8a77c0111352ce45a14c30f.zip - location: git: git@github.com:commercialhaskell/stack.git commit: 6a86ee32e5b869a877151f74064572225e1a0398 - location: hg: https://example.com/hg/repo commit: da39a3ee5e6b4b0d3255bfef95601890afd80709 ``` Note: it is highly recommended that you only use SHA1 values for a Git or Mercurial commit. Other values may work, but they are not officially supported, and may result in unexpected behavior (namely, stack will not automatically pull to update to new versions). A `location` key can be accompanied by a `subdirs` key to look for cabal files in a list of subdirectories as well in addition to the top level directory. This could be useful for mega-repos like [wai](https://github.com/yesodweb/wai/) or [digestive-functors](https://github.com/jaspervdj/digestive-functors). The `subdirs` key can have multiple nested series items specifying a list of subdirectories. For example: ```yaml packages: - location: . subdirs: - subdir1 - subdir2 - location: git: git@github.com:yesodweb/wai commit: 2f8a8e1b771829f4a8a77c0111352ce45a14c30f subdirs: - auto-update - wai - location: http://github.com/yesodweb/wai/archive/2f8a8e1b771829f4a8a77c0111352ce45a14c30f.zip subdirs: - auto-update - wai ``` #### Local dependency packages (`extra-dep`) A `location` key can be accompanied by an `extra-dep` key. When the `extra-dep` key is set to `true` it indicates that the package should be treated in the same way as a dependency package and not as part of the project. This means the following: * A _dependency package_ is built only if a user package or its dependencies depend on it. Note that a regular _project package_ is built anyway even if no other package depends on it. * Its test suites and benchmarks will not be run. * It will not be directly loaded in ghci when `stack ghci` is run. This is important because if you specify huge dependencies as project packages then ghci will have a nightmare loading everything. This is especially useful when you are tweaking upstream packages or want to use latest versions of the upstream packages which are not yet on Hackage or Stackage. For example: ```yaml packages: - location: . - location: vendor/binary extra-dep: true - location: git: git@github.com:yesodweb/wai commit: 2f8a8e1b771829f4a8a77c0111352ce45a14c30f subdirs: - auto-update - wai extra-dep: true ``` ### extra-deps This is a list of package identifiers for additional packages from upstream to be included. This is usually used to augment an LTS Haskell or Stackage Nightly snapshot with a package that is not present or is at an different version than you wish to use. ```yaml extra-deps: - acme-missiles-0.3 ``` Note that the `extra-dep` attribute in the `packages` section as described in an earlier section is used for non-index local or remote packages while the `extra-deps` section is for packages to be automatically pulled from an index like Hackage. ### resolver Specifies how dependencies are resolved. There are currently four resolver types: * LTS Haskell snapshots, e.g. `resolver: lts-2.14` * Stackage Nightly snapshot, e.g. `resolver: nightly-2015-06-16` * No snapshot, just use packages shipped with the compiler * For GHC this looks like `resolver: ghc-7.10.2` * For GHCJS this looks like `resolver: ghcjs-0.1.0_ghc-7.10.2`. * [Custom snapshot](https://github.com/commercialhaskell/stack/wiki/Custom-Snapshot) Each of these resolvers will also determine what constraints are placed on the compiler version. See the [compiler-check](#compiler-check) option for some additional control over compiler version. ### flags Flags can be set for each package separately, e.g. ```yaml flags: package-name: flag-name: true ``` Flags will only affect packages in your `packages` and `extra-deps` settings. Packages that come from the snapshot global database are not affected. ### image The image settings are used for the creation of container images using `stack image container`, e.g. ```yaml image: containers: - base: "fpco/stack-build" add: static: /data/static ``` `base` is the docker image that will be used to built upon. The `add` lines allow you to add additional directories to your image. You can specify the name of the image using `name` (otherwise it defaults to the same as your project). You can also specify `entrypoints`. By default all your executables are placed in `/usr/local/bin`, but you can specify a list using `executables` to only add some. ### user-message A user-message is inserted by `stack init` when it omits packages or adds external dependencies. For example: ```yaml user-message: ! 'Warning: Some packages were found to be incompatible with the resolver and have been left commented out in the packages section. Warning: Specified resolver could not satisfy all dependencies. Some external packages have been added as dependencies. You can suppress this message by removing it from stack.yaml ' ``` This messages is displayed every time the config is loaded by stack and serves as a reminder for the user to review the configuration and make any changes if needed. The user can delete this message if the generated configuration is acceptable. ## Non-project config Non-project config options may go in the global config (`/etc/stack/config.yaml`) or the user config (`~/.stack/config.yaml`). ### docker See [Docker integration](docker_integration.md#configuration). ### nix (since 0.1.10.0) See [Nix integration](nix_integration.md#configuration). ### connection-count Integer indicating how many simultaneous downloads are allowed to happen Default: `8` ### hide-th-loading Strip out the "Loading ..." lines from GHC build output, produced when using Template Haskell Default: `true` ### latest-snapshot-url URL providing a JSON with information on the latest LTS and Nightly snapshots, used for automatic project configuration. Default: `https://www.stackage.org/download/snapshots.json` ### local-bin-path Target directory for `stack install` and `stack build --copy-bins`. Default: `~/.local/bin` ### package-indices ```yaml package-indices: - name: Hackage download-prefix: https://s3.amazonaws.com/hackage.fpcomplete.com/package/ # at least one of the following must be present git: https://github.com/commercialhaskell/all-cabal-hashes.git http: https://s3.amazonaws.com/hackage.fpcomplete.com/00-index.tar.gz # optional fields, both default to false gpg-verify: false require-hashes: false ``` One thing you should be aware of: if you change the contents of package-version combination by setting a different package index, this *can* have an effect on other projects by installing into your shared snapshot database. ### system-ghc Enables or disables using the GHC available on the PATH. Useful to disable if you want to force stack to use its own installed GHC (via `stack setup`), in cases where your system GHC my be incomplete for some reason. Default is `true`. ```yaml # Turn off system GHC system-ghc: false ``` ### install-ghc Whether or not to automatically install GHC when necessary. Default is `false`, which means stack will prompt you to run `stack setup` as needed. ### skip-ghc-check Should we skip the check to confirm that your system GHC version (on the PATH) matches what your project expects? Default is `false`. ### require-stack-version Require a version of stack within the specified range ([cabal-style](https://www.haskell.org/cabal/users-guide/developing-packages.html#build-information)) to be used for this project. Example: `require-stack-version: "== 0.1.*"` Default: `"-any"` ### arch/os Set the architecture and operating system for GHC, build directories, etc. Values are those recognized by Cabal, e.g.: arch: i386, x86_64 os: windows, linux You likely only ever want to change the arch value. This can also be set via the command line. ### extra-include-dirs/extra-lib-dirs A list of extra paths to be searched for header files and libraries, respectively. Paths should be absolute ```yaml extra-include-dirs: - /opt/foo/include extra-lib-dirs: - /opt/foo/lib ``` ### compiler-check (Since 0.1.4) Specifies how the compiler version in the resolver is matched against concrete versions. Valid values: * `match-minor`: make sure that the first three components match, but allow patch-level differences. For example< 7.8.4.1 and 7.8.4.2 would both match 7.8.4. This is useful to allow for custom patch levels of a compiler. This is the default * `match-exact`: the entire version number must match precisely * `newer-minor`: the third component can be increased, e.g. if your resolver is `ghc-7.10.1`, then 7.10.2 will also be allowed. This was the default up through stack 0.1.3 ### compiler (Since 0.1.7) Overrides the compiler version in the resolver. Note that the `compiler-check` flag also applies to the version numbers. This uses the same syntax as compiler resolvers like `ghc-7.10.2` or `ghcjs-0.1.0.20150924_ghc-7.10.2` (version used for the 'old-base' version of GHCJS). While it's useful to override the compiler for a variety of reasons, the main usecase is to use GHCJS with a stackage snapshot, like this: ```yaml resolver: lts-3.10 compiler: ghcjs-0.1.0.20150924_ghc-7.10.2 compiler-check: match-exact ``` ### ghc-options (Since 0.1.4) Allows specifying per-package and global GHC options: ```yaml ghc-options: # All packages "*": -Wall some-package: -DSOME_CPP_FLAG ``` Caveat emptor: setting options like this will affect your snapshot packages, which can lead to unpredictable behavior versus official Stackage snapshots. This is in contrast to the `ghc-options` command line flag, which will only affect local packages. ### ghc-variant (Since 0.1.5) Specify a variant binary distribution of GHC to use. Known values: * `standard`: This is the default, uses the standard GHC binary distribution * `gmp4`: Use the "centos6" GHC bindist, for Linux systems with libgmp4 (aka `libgmp.so.3`), such as CentOS 6. This variant will be used automatically on such systems; you should not need to specify it in the configuration * `integersimple`: Use a GHC bindist that uses [integer-simple instead of GMP](https://ghc.haskell.org/trac/ghc/wiki/ReplacingGMPNotes) * any other value: Use a custom GHC bindist. You should specify [setup-info](#setup-info) so `stack setup` knows where to download it, or pass the `stack setup --ghc-bindist` argument on the command-line ### setup-info (Since 0.1.5) Allows overriding from where tools like GHC and msys2 (on Windows) are downloaded. Most useful for specifying locations of custom GHC binary distributions (for use with the [ghc-variant](#ghc-variant) option): ```yaml setup-info: ghc: windows32-custom-foo: 7.10.2: url: "https://example.com/ghc-7.10.2-i386-unknown-mingw32-foo.tar.xz" ``` ### pvp-bounds (Since 0.1.5) When using the `sdist` and `upload` commands, this setting determines whether the cabal file's dependencies should be modified to reflect PVP lower and upper bounds. Values are `none` (unchanged), `upper` (add upper bounds), `lower` (add lower bounds), and both (and upper and lower bounds). The algorithm it follows is: * If an upper or lower bound already exists on a dependency, it's left alone * When adding a lower bound, we look at the current version specified by stack.yaml, and set it as the lower bound (e.g., `foo >= 1.2.3`) * When adding an upper bound, we require less than the next major version (e.g., `foo < 1.3`) ```yaml pvp-bounds: none ``` For more information, see [the announcement blog post](https://www.fpcomplete.com/blog/2015/09/stack-pvp). ### modify-code-page (Since 0.1.6) Modify the code page for UTF-8 output when running on Windows. Default behavior is to modify. ```yaml modify-code-page: false ``` ### explicit-setup-deps (Since 0.1.6) Decide whether a custom `Setup.hs` script should be run with an explicit list of dependencies, based on the dependencies of the package itself. It associates the name of a local package with a boolean. When it's `true`, the `Setup.hs` script is built with an explicit list of packages. When it's `false` (default), the `Setup.hs` script is built without access to the local DB, but can access any package in the snapshot / global DB. Note that in the future, this will be unnecessary, once Cabal provides full support for explicit Setup.hs dependencies. ```yaml explicit-setup-deps: "*": true # change the default entropy: false # override the new default for one package ``` ### rebuild-ghc-options (Since 0.1.6) Should we rebuild a package when its GHC options change? Before 0.1.6, this was a non-configurable true. However, in most cases, the flag is used to affect optimization levels and warning behavior, for which GHC itself doesn't actually recompile the modules anyway. Therefore, the new behavior is to not recompile on an options change, but this behavior can be changed back with the following: ```yaml rebuild-ghc-options: true ``` ### apply-ghc-options (Since 0.1.6) Which packages do ghc-options on the command line get applied to? Before 0.1.6, the default value was `targets` ```yaml apply-ghc-options: locals # all local packages, the default # apply-ghc-options: targets # all local packages that are targets # apply-ghc-options: everything # applied even to snapshot and extra-deps ``` Note that `everything` is a slightly dangerous value, as it can break invariants about your snapshot database. ### allow-newer (Since 0.1.7) Ignore version bounds in .cabal files. Default is false. ```yaml allow-newer: true ``` Note that this also ignores lower bounds. The name "allow-newer" is chosen to match the commonly used cabal option. ### allow-different-user (Since 1.0.1) Allow users other than the owner of the stack root directory (typically `~/.stack`) to use the stack installation. The default is `false`. POSIX systems only. ```yaml allow-different-user: true ``` The intention of this option is to prevent file permission problems, for example as the result of a `stack` command executed under `sudo`. The option is automatically enabled when `stack` is re-spawned in a Docker process. ### templates Templates used with `stack new` have a number of parameters that affect the generated code. These can be set for all new projects you create. The result of them can be observed in the generated LICENSE and cabal files. The 5 parameters are: `author-email`, `author-name`, `category`, `copyright` and `github-username`. * _author-email_ - sets the `maintainer` property in cabal * _author-name_ - sets the `author` property in cabal and the name used in LICENSE * _category_ - sets the `category` property in cabal. This is used in Hackage. For examples of categories see [Packages by category](https://hackage.haskell.org/packages/). It makes sense for `category` to be set on a per project basis because it is uncommon for all projects a user creates to belong to the same category. The category can be set per project by passing `-p "category:value"` to the `stack new` command. * _copyright_ - sets the `copyright` property in cabal. It is typically the name of the holder of the copyright on the package and the year(s) from which copyright is claimed. For example: `Copyright: (c) 2006-2007 Joe Bloggs` * _github-username_ - used to generate `homepage` and `source-repository` in cabal. For instance `github-username: myusername` and `stack new my-project new-template` would result: ```yaml homepage: http://github.com/myusername/my-project#readme source-repository head type: git location: https://github.com/myusername/my-project ``` These properties can be set in `config.yaml` as follows: ```yaml templates: params: author-name: Your Name author-email: youremail@example.com category: Your Projects Category copyright: 'Copyright: (c) 2016 Your Name' github-username: yourusername ``` stack-1.1.2/test/package-dump/ghc-7.8.txt0000644000000000000000000020004412534327003016136 0ustar0000000000000000name: haskell2010 version: 1.1.2.0 id: haskell2010-1.1.2.0-05c8dd51009e08c6371c82972d40f55a license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: http://www.haskell.org/onlinereport/haskell2010/ package-url: synopsis: Compatibility with Haskell 2010 description: This package provides exactly the library modules defined by the . category: Haskell2010, Prelude author: exposed: False exposed-modules: Prelude Control.Monad Data.Array Data.Bits Data.Char Data.Complex Data.Int Data.Ix Data.List Data.Maybe Data.Ratio Data.Word Foreign Foreign.C Foreign.C.Error Foreign.C.String Foreign.C.Types Foreign.ForeignPtr Foreign.Marshal Foreign.Marshal.Alloc Foreign.Marshal.Array Foreign.Marshal.Error Foreign.Marshal.Utils Foreign.Ptr Foreign.StablePtr Foreign.Storable Numeric System.Environment System.Exit System.IO System.IO.Error hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/haskell2010-1.1.2.0 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/haskell2010-1.1.2.0 hs-libraries: HShaskell2010-1.1.2.0 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 ghc-prim-0.3.1.0-a24f9c14c632d75b683d0f93283aea37 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskell2010-1.1.2.0/haskell2010.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskell2010-1.1.2.0 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: haskell98 version: 2.0.0.3 id: haskell98-2.0.0.3-045e8778b656db76e2c729405eee707b license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: http://www.haskell.org/definition/ package-url: synopsis: Compatibility with Haskell 98 description: This package provides compatibility with the modules of Haskell 98 and the FFI addendum, by means of wrappers around modules from the base package (which in many cases have additional features). However "Prelude", "Numeric" and "Foreign" are provided directly by the @base@ package. category: Haskell98, Prelude author: exposed: False exposed-modules: Prelude Array CPUTime Char Complex Directory IO Ix List Locale Maybe Monad Numeric Random Ratio System Time Bits CError CForeign CString CTypes ForeignPtr Int MarshalAlloc MarshalArray MarshalError MarshalUtils Ptr StablePtr Storable Word hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/haskell98-2.0.0.3 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/haskell98-2.0.0.3 hs-libraries: HShaskell98-2.0.0.3 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 directory-1.2.1.0-07cd1f59e3c6cac5e3e180019c59a115 old-locale-1.0.0.6-50b0125c49f76af85dc7aa22975cdc34 old-time-1.1.0.2-e3f776e97c1a6ff1770b04943a7ef7c6 process-1.2.0.0-06c3215a79834ce4886ae686a0f81122 time-1.4.2-9b3076800c33f8382c38628f35717951 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskell98-2.0.0.3/haskell98.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskell98-2.0.0.3 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: old-time version: 1.1.0.2 id: old-time-1.1.0.2-e3f776e97c1a6ff1770b04943a7ef7c6 license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: package-url: synopsis: Time library description: This package provides the old time library. . For new projects, the newer is recommended. category: System author: exposed: True exposed-modules: System.Time hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/old-time-1.1.0.2 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/old-time-1.1.0.2 hs-libraries: HSold-time-1.1.0.2 extra-libraries: extra-ghci-libraries: include-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/old-time-1.1.0.2/include includes: HsTime.h depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 old-locale-1.0.0.6-50b0125c49f76af85dc7aa22975cdc34 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/old-time-1.1.0.2/old-time.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/old-time-1.1.0.2 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: ghc version: 7.8.4 id: ghc-7.8.4-6c4818bc66adb23509058069f781d99a license: BSD3 copyright: maintainer: glasgow-haskell-users@haskell.org stability: homepage: http://www.haskell.org/ghc/ package-url: synopsis: The GHC API description: GHC's functionality can be useful for more things than just compiling Haskell programs. Important use cases are programs that analyse (and perhaps transform) Haskell code. Others include loading Haskell code dynamically in a GHCi-like manner. For this reason, a lot of GHC's functionality is made available through this package. category: Development author: The GHC Team exposed: False exposed-modules: Avail BasicTypes ConLike DataCon PatSyn Demand Exception GhcMonad Hooks Id IdInfo Literal Llvm Llvm.AbsSyn Llvm.MetaData Llvm.PpLlvm Llvm.Types LlvmCodeGen LlvmCodeGen.Base LlvmCodeGen.CodeGen LlvmCodeGen.Data LlvmCodeGen.Ppr LlvmCodeGen.Regs LlvmMangler MkId Module Name NameEnv NameSet OccName RdrName SrcLoc UniqSupply Unique Var VarEnv VarSet BlockId CLabel Cmm CmmBuildInfoTables CmmPipeline CmmCallConv CmmCommonBlockElim CmmContFlowOpt CmmExpr CmmInfo CmmLex CmmLint CmmLive CmmMachOp CmmNode CmmOpt CmmParse CmmProcPoint CmmRewriteAssignments CmmSink CmmType CmmUtils CmmLayoutStack MkGraph PprBase PprC PprCmm PprCmmDecl PprCmmExpr Bitmap CodeGen.Platform CodeGen.Platform.ARM CodeGen.Platform.NoRegs CodeGen.Platform.PPC CodeGen.Platform.PPC_Darwin CodeGen.Platform.SPARC CodeGen.Platform.X86 CodeGen.Platform.X86_64 CgUtils StgCmm StgCmmBind StgCmmClosure StgCmmCon StgCmmEnv StgCmmExpr StgCmmForeign StgCmmHeap StgCmmHpc StgCmmArgRep StgCmmLayout StgCmmMonad StgCmmPrim StgCmmProf StgCmmTicky StgCmmUtils StgCmmExtCode SMRep CoreArity CoreFVs CoreLint CorePrep CoreSubst CoreSyn TrieMap CoreTidy CoreUnfold CoreUtils ExternalCore MkCore MkExternalCore PprCore PprExternalCore Check Coverage Desugar DsArrows DsBinds DsCCall DsExpr DsForeign DsGRHSs DsListComp DsMonad DsUtils Match MatchCon MatchLit HsBinds HsDecls HsDoc HsExpr HsImpExp HsLit HsPat HsSyn HsTypes HsUtils BinIface BuildTyCl IfaceEnv IfaceSyn IfaceType LoadIface MkIface TcIface FlagChecker Annotations BreakArray CmdLineParser CodeOutput Config Constants DriverMkDepend DriverPhases PipelineMonad DriverPipeline DynFlags ErrUtils Finder GHC GhcMake GhcPlugins DynamicLoading HeaderInfo HscMain HscStats HscTypes InteractiveEval InteractiveEvalTypes PackageConfig Packages PlatformConstants PprTyThing StaticFlags SysTools TidyPgm Ctype HaddockUtils LexCore Lexer OptCoercion Parser ParserCore ParserCoreUtils RdrHsSyn ForeignCall PrelInfo PrelNames PrelRules PrimOp TysPrim TysWiredIn CostCentre ProfInit SCCfinal RnBinds RnEnv RnExpr RnHsDoc RnNames RnPat RnSource RnSplice RnTypes CoreMonad CSE FloatIn FloatOut LiberateCase OccurAnal SAT SetLevels SimplCore SimplEnv SimplMonad SimplUtils Simplify SimplStg StgStats UnariseStg Rules SpecConstr Specialise CoreToStg StgLint StgSyn DmdAnal WorkWrap WwLib FamInst Inst TcAnnotations TcArrows TcBinds TcClassDcl TcDefaults TcDeriv TcEnv TcExpr TcForeign TcGenDeriv TcGenGenerics TcHsSyn TcHsType TcInstDcls TcMType TcValidity TcMatches TcPat TcPatSyn TcRnDriver TcRnMonad TcRnTypes TcRules TcSimplify TcErrors TcTyClsDecls TcTyDecls TcType TcEvidence TcUnify TcInteract TcCanonical TcSMonad TcTypeNats TcSplice Class Coercion FamInstEnv FunDeps InstEnv TyCon CoAxiom Kind Type TypeRep Unify Bag Binary BooleanFormula BufWrite Digraph Encoding FastBool FastFunctions FastMutInt FastString FastTypes Fingerprint FiniteMap GraphBase GraphColor GraphOps GraphPpr IOEnv ListSetOps Maybes MonadUtils OrdList Outputable Pair Panic Pretty Serialized State Stream StringBuffer UniqFM UniqSet Util ExtsCompat46 Vectorise.Builtins.Base Vectorise.Builtins.Initialise Vectorise.Builtins Vectorise.Monad.Base Vectorise.Monad.Naming Vectorise.Monad.Local Vectorise.Monad.Global Vectorise.Monad.InstEnv Vectorise.Monad Vectorise.Utils.Base Vectorise.Utils.Closure Vectorise.Utils.Hoisting Vectorise.Utils.PADict Vectorise.Utils.Poly Vectorise.Utils Vectorise.Generic.Description Vectorise.Generic.PAMethods Vectorise.Generic.PADict Vectorise.Generic.PData Vectorise.Type.Env Vectorise.Type.Type Vectorise.Type.TyConDecl Vectorise.Type.Classify Vectorise.Convert Vectorise.Vect Vectorise.Var Vectorise.Env Vectorise.Exp Vectorise Hoopl.Dataflow Hoopl AsmCodeGen TargetReg NCGMonad Instruction Size Reg RegClass PIC Platform CPrim X86.Regs X86.RegInfo X86.Instr X86.Cond X86.Ppr X86.CodeGen PPC.Regs PPC.RegInfo PPC.Instr PPC.Cond PPC.Ppr PPC.CodeGen SPARC.Base SPARC.Regs SPARC.Imm SPARC.AddrMode SPARC.Cond SPARC.Instr SPARC.Stack SPARC.ShortcutJump SPARC.Ppr SPARC.CodeGen SPARC.CodeGen.Amode SPARC.CodeGen.Base SPARC.CodeGen.CondCode SPARC.CodeGen.Gen32 SPARC.CodeGen.Gen64 SPARC.CodeGen.Sanity SPARC.CodeGen.Expand RegAlloc.Liveness RegAlloc.Graph.Main RegAlloc.Graph.Stats RegAlloc.Graph.ArchBase RegAlloc.Graph.ArchX86 RegAlloc.Graph.Coalesce RegAlloc.Graph.Spill RegAlloc.Graph.SpillClean RegAlloc.Graph.SpillCost RegAlloc.Graph.TrivColorable RegAlloc.Linear.Main RegAlloc.Linear.JoinToTargets RegAlloc.Linear.State RegAlloc.Linear.Stats RegAlloc.Linear.FreeRegs RegAlloc.Linear.StackMap RegAlloc.Linear.Base RegAlloc.Linear.X86.FreeRegs RegAlloc.Linear.X86_64.FreeRegs RegAlloc.Linear.PPC.FreeRegs RegAlloc.Linear.SPARC.FreeRegs DsMeta Convert ByteCodeAsm ByteCodeGen ByteCodeInstr ByteCodeItbls ByteCodeLink Debugger LibFFI Linker ObjLink RtClosureInspect DebuggerUtils hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/ghc-7.8.4 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/ghc-7.8.4 hs-libraries: HSghc-7.8.4 extra-libraries: extra-ghci-libraries: include-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/ghc-7.8.4/include includes: depends: Cabal-1.18.1.5-6478013104bde01737bfd67d34bbee0a array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 bin-package-db-0.0.0.0-0f3da03684207f2dc4dce793df1db62e bytestring-0.10.4.0-d6f1d17d717e8652498cab8269a0acd5 containers-0.5.5.1-d4bd887fb97aa3a46cbadc13709b7653 directory-1.2.1.0-07cd1f59e3c6cac5e3e180019c59a115 filepath-1.3.0.2-25a474a9272ae6260626ce0d70ad1cab hoopl-3.10.0.1-267659e4b5b51c3d2e02f2a6d6f46936 hpc-0.6.0.1-cca17f12dab542e09c423a74a4590c5d process-1.2.0.0-06c3215a79834ce4886ae686a0f81122 template-haskell-2.9.0.0-6d27c2b362b15abb1822f2f34b9ae7f9 time-1.4.2-9b3076800c33f8382c38628f35717951 transformers-0.3.0.0-6458c21515cab7c1cf21e53141557a1c unix-2.7.0.1-f8658ba9ec1c4fba8a371a8e0f42ec6c hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/ghc-7.8.4/ghc.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/ghc-7.8.4 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: haskeline version: 0.7.1.2 id: haskeline-0.7.1.2-2dd2f2fb537352f5367ae77fe47ab211 license: BSD3 copyright: (c) Judah Jacobson maintainer: Judah Jacobson stability: Experimental homepage: http://trac.haskell.org/haskeline package-url: synopsis: A command-line interface for user input, written in Haskell. description: Haskeline provides a user interface for line input in command-line programs. This library is similar in purpose to readline, but since it is written in Haskell it is (hopefully) more easily used in other Haskell programs. . Haskeline runs both on POSIX-compatible systems and on Windows. category: User Interfaces author: Judah Jacobson exposed: True exposed-modules: System.Console.Haskeline System.Console.Haskeline.Completion System.Console.Haskeline.MonadException System.Console.Haskeline.History System.Console.Haskeline.IO hidden-modules: System.Console.Haskeline.Backend System.Console.Haskeline.Backend.WCWidth System.Console.Haskeline.Command System.Console.Haskeline.Command.Completion System.Console.Haskeline.Command.History System.Console.Haskeline.Command.KillRing System.Console.Haskeline.Directory System.Console.Haskeline.Emacs System.Console.Haskeline.InputT System.Console.Haskeline.Key System.Console.Haskeline.LineState System.Console.Haskeline.Monads System.Console.Haskeline.Prefs System.Console.Haskeline.RunCommand System.Console.Haskeline.Term System.Console.Haskeline.Command.Undo System.Console.Haskeline.Vi System.Console.Haskeline.Recover System.Console.Haskeline.Backend.Posix System.Console.Haskeline.Backend.Posix.Encoder System.Console.Haskeline.Backend.DumbTerm System.Console.Haskeline.Backend.Terminfo trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/haskeline-0.7.1.2 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/haskeline-0.7.1.2 hs-libraries: HShaskeline-0.7.1.2 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 bytestring-0.10.4.0-d6f1d17d717e8652498cab8269a0acd5 containers-0.5.5.1-d4bd887fb97aa3a46cbadc13709b7653 directory-1.2.1.0-07cd1f59e3c6cac5e3e180019c59a115 filepath-1.3.0.2-25a474a9272ae6260626ce0d70ad1cab terminfo-0.4.0.0-c1d02a7210b0d1bc250d87463b38b8d1 transformers-0.3.0.0-6458c21515cab7c1cf21e53141557a1c unix-2.7.0.1-f8658ba9ec1c4fba8a371a8e0f42ec6c hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskeline-0.7.1.2/haskeline.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/haskeline-0.7.1.2 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: terminfo version: 0.4.0.0 id: terminfo-0.4.0.0-c1d02a7210b0d1bc250d87463b38b8d1 license: BSD3 copyright: (c) Judah Jacobson maintainer: Judah Jacobson stability: Stable homepage: https://github.com/judah/terminfo package-url: synopsis: Haskell bindings to the terminfo library. description: This library provides an interface to the terminfo database (via bindings to the curses library). allows POSIX systems to interact with a variety of terminals using a standard set of capabilities. category: User Interfaces author: Judah Jacobson exposed: True exposed-modules: System.Console.Terminfo System.Console.Terminfo.Base System.Console.Terminfo.Cursor System.Console.Terminfo.Color System.Console.Terminfo.Edit System.Console.Terminfo.Effects System.Console.Terminfo.Keys hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/terminfo-0.4.0.0 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/terminfo-0.4.0.0 hs-libraries: HSterminfo-0.4.0.0 extra-libraries: tinfo extra-ghci-libraries: include-dirs: includes: ncurses.h term.h depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/terminfo-0.4.0.0/terminfo.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/terminfo-0.4.0.0 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: xhtml version: 3000.2.1 id: xhtml-3000.2.1-6a3ed472b07e58fe29db22a5bc2bdb06 license: BSD3 copyright: Bjorn Bringert 2004-2006, Andy Gill and the Oregon Graduate Institute of Science and Technology, 1999-2001 maintainer: Chris Dornan stability: Stable homepage: https://github.com/haskell/xhtml package-url: synopsis: An XHTML combinator library description: This package provides combinators for producing XHTML 1.0, including the Strict, Transitional and Frameset variants. category: Web, XML, Pretty Printer author: Bjorn Bringert exposed: True exposed-modules: Text.XHtml Text.XHtml.Frameset Text.XHtml.Strict Text.XHtml.Transitional Text.XHtml.Debug Text.XHtml.Table hidden-modules: Text.XHtml.Strict.Attributes Text.XHtml.Strict.Elements Text.XHtml.Frameset.Attributes Text.XHtml.Frameset.Elements Text.XHtml.Transitional.Attributes Text.XHtml.Transitional.Elements Text.XHtml.BlockTable Text.XHtml.Extras Text.XHtml.Internals trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/xhtml-3000.2.1 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/xhtml-3000.2.1 hs-libraries: HSxhtml-3000.2.1 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/xhtml-3000.2.1/xhtml.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/xhtml-3000.2.1 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: transformers version: 0.3.0.0 id: transformers-0.3.0.0-6458c21515cab7c1cf21e53141557a1c license: BSD3 copyright: maintainer: Ross Paterson stability: homepage: package-url: synopsis: Concrete functor and monad transformers description: A portable library of functor and monad transformers, inspired by the paper \"Functional Programming with Overloading and Higher-Order Polymorphism\", by Mark P Jones, in /Advanced School of Functional Programming/, 1995 (). . This package contains: . * the monad transformer class (in "Control.Monad.Trans.Class") . * concrete functor and monad transformers, each with associated operations and functions to lift operations associated with other transformers. . It can be used on its own in portable Haskell code, or with the monad classes in the @mtl@ or @monads-tf@ packages, which automatically lift operations introduced by monad transformers through other transformers. category: Control author: Andy Gill, Ross Paterson exposed: True exposed-modules: Control.Applicative.Backwards Control.Applicative.Lift Control.Monad.IO.Class Control.Monad.Trans.Class Control.Monad.Trans.Cont Control.Monad.Trans.Error Control.Monad.Trans.Identity Control.Monad.Trans.List Control.Monad.Trans.Maybe Control.Monad.Trans.Reader Control.Monad.Trans.RWS Control.Monad.Trans.RWS.Lazy Control.Monad.Trans.RWS.Strict Control.Monad.Trans.State Control.Monad.Trans.State.Lazy Control.Monad.Trans.State.Strict Control.Monad.Trans.Writer Control.Monad.Trans.Writer.Lazy Control.Monad.Trans.Writer.Strict Data.Functor.Compose Data.Functor.Constant Data.Functor.Identity Data.Functor.Product Data.Functor.Reverse hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/transformers-0.3.0.0 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/transformers-0.3.0.0 hs-libraries: HStransformers-0.3.0.0 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/transformers-0.3.0.0/transformers.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/transformers-0.3.0.0 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: hoopl version: 3.10.0.1 id: hoopl-3.10.0.1-267659e4b5b51c3d2e02f2a6d6f46936 license: BSD3 copyright: maintainer: nr@cs.tufts.edu stability: homepage: http://ghc.cs.tufts.edu/hoopl/ package-url: synopsis: A library to support dataflow analysis and optimization description: Higher-order optimization library . See /Norman Ramsey, Joao Dias, and Simon Peyton Jones./ /(2010)/ for more details. category: Compilers/Interpreters author: Norman Ramsey, Joao Dias, Simon Marlow and Simon Peyton Jones exposed: True exposed-modules: Compiler.Hoopl Compiler.Hoopl.Internals Compiler.Hoopl.Wrappers Compiler.Hoopl.Passes.Dominator Compiler.Hoopl.Passes.DList hidden-modules: Compiler.Hoopl.Checkpoint Compiler.Hoopl.Collections Compiler.Hoopl.Combinators Compiler.Hoopl.Dataflow Compiler.Hoopl.Debug Compiler.Hoopl.Block Compiler.Hoopl.Graph Compiler.Hoopl.Label Compiler.Hoopl.MkGraph Compiler.Hoopl.Fuel Compiler.Hoopl.Pointed Compiler.Hoopl.Shape Compiler.Hoopl.Show Compiler.Hoopl.Unique Compiler.Hoopl.XUtil trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/hoopl-3.10.0.1 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/hoopl-3.10.0.1 hs-libraries: HShoopl-3.10.0.1 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 containers-0.5.5.1-d4bd887fb97aa3a46cbadc13709b7653 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/hoopl-3.10.0.1/hoopl.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/hoopl-3.10.0.1 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: bin-package-db version: 0.0.0.0 id: bin-package-db-0.0.0.0-0f3da03684207f2dc4dce793df1db62e license: BSD3 copyright: maintainer: ghc-devs@haskell.org stability: homepage: package-url: synopsis: A binary format for the package database description: category: author: exposed: True exposed-modules: Distribution.InstalledPackageInfo.Binary hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/bin-package-db-0.0.0.0 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/bin-package-db-0.0.0.0 hs-libraries: HSbin-package-db-0.0.0.0 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: Cabal-1.18.1.5-6478013104bde01737bfd67d34bbee0a base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 binary-0.7.1.0-f867dbbb69966feb9f5c4ef7695a70a5 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/bin-package-db-0.0.0.0/bin-package-db.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/bin-package-db-0.0.0.0 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: binary version: 0.7.1.0 id: binary-0.7.1.0-f867dbbb69966feb9f5c4ef7695a70a5 license: BSD3 copyright: maintainer: Lennart Kolmodin, Don Stewart stability: provisional homepage: https://github.com/kolmodin/binary package-url: synopsis: Binary serialisation for Haskell values using lazy ByteStrings description: Efficient, pure binary serialisation using lazy ByteStrings. Haskell values may be encoded to and from binary formats, written to disk as binary, or sent over the network. The format used can be automatically generated, or you can choose to implement a custom format if needed. Serialisation speeds of over 1 G\/sec have been observed, so this library should be suitable for high performance scenarios. category: Data, Parsing author: Lennart Kolmodin exposed: True exposed-modules: Data.Binary Data.Binary.Put Data.Binary.Get Data.Binary.Get.Internal Data.Binary.Builder Data.Binary.Builder.Internal hidden-modules: Data.Binary.Builder.Base Data.Binary.Class Data.Binary.Generic trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/binary-0.7.1.0 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/binary-0.7.1.0 hs-libraries: HSbinary-0.7.1.0 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 bytestring-0.10.4.0-d6f1d17d717e8652498cab8269a0acd5 containers-0.5.5.1-d4bd887fb97aa3a46cbadc13709b7653 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/binary-0.7.1.0/binary.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/binary-0.7.1.0 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: Cabal version: 1.18.1.5 id: Cabal-1.18.1.5-6478013104bde01737bfd67d34bbee0a license: BSD3 copyright: 2003-2006, Isaac Jones 2005-2011, Duncan Coutts maintainer: cabal-devel@haskell.org stability: homepage: http://www.haskell.org/cabal/ package-url: synopsis: A framework for packaging Haskell software description: The Haskell Common Architecture for Building Applications and Libraries: a framework defining a common interface for authors to more easily build their Haskell applications in a portable way. . The Haskell Cabal is part of a larger infrastructure for distributing, organizing, and cataloging Haskell libraries and tools. category: Distribution author: Isaac Jones Duncan Coutts exposed: True exposed-modules: Distribution.Compat.Environment Distribution.Compat.Exception Distribution.Compat.ReadP Distribution.Compiler Distribution.InstalledPackageInfo Distribution.License Distribution.Make Distribution.ModuleName Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Check Distribution.PackageDescription.Configuration Distribution.PackageDescription.Parse Distribution.PackageDescription.PrettyPrint Distribution.PackageDescription.Utils Distribution.ParseUtils Distribution.ReadE Distribution.Simple Distribution.Simple.Bench Distribution.Simple.Build Distribution.Simple.Build.Macros Distribution.Simple.Build.PathsModule Distribution.Simple.BuildPaths Distribution.Simple.BuildTarget Distribution.Simple.CCompiler Distribution.Simple.Command Distribution.Simple.Compiler Distribution.Simple.Configure Distribution.Simple.GHC Distribution.Simple.Haddock Distribution.Simple.Hpc Distribution.Simple.Hugs Distribution.Simple.Install Distribution.Simple.InstallDirs Distribution.Simple.JHC Distribution.Simple.LHC Distribution.Simple.LocalBuildInfo Distribution.Simple.NHC Distribution.Simple.PackageIndex Distribution.Simple.PreProcess Distribution.Simple.PreProcess.Unlit Distribution.Simple.Program Distribution.Simple.Program.Ar Distribution.Simple.Program.Builtin Distribution.Simple.Program.Db Distribution.Simple.Program.Find Distribution.Simple.Program.GHC Distribution.Simple.Program.HcPkg Distribution.Simple.Program.Hpc Distribution.Simple.Program.Ld Distribution.Simple.Program.Run Distribution.Simple.Program.Script Distribution.Simple.Program.Types Distribution.Simple.Register Distribution.Simple.Setup Distribution.Simple.SrcDist Distribution.Simple.Test Distribution.Simple.UHC Distribution.Simple.UserHooks Distribution.Simple.Utils Distribution.System Distribution.TestSuite Distribution.Text Distribution.Verbosity Distribution.Version Language.Haskell.Extension hidden-modules: Distribution.Compat.CopyFile Distribution.Compat.TempFile Distribution.GetOpt Distribution.Simple.GHC.IPI641 Distribution.Simple.GHC.IPI642 Paths_Cabal trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/Cabal-1.18.1.5 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/Cabal-1.18.1.5 hs-libraries: HSCabal-1.18.1.5 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 bytestring-0.10.4.0-d6f1d17d717e8652498cab8269a0acd5 containers-0.5.5.1-d4bd887fb97aa3a46cbadc13709b7653 deepseq-1.3.0.2-63a1ab91b7017a28bb5d04cb1b5d2d02 directory-1.2.1.0-07cd1f59e3c6cac5e3e180019c59a115 filepath-1.3.0.2-25a474a9272ae6260626ce0d70ad1cab pretty-1.1.1.1-0984f47ffe93ef3983c80b96280f1c3a process-1.2.0.0-06c3215a79834ce4886ae686a0f81122 time-1.4.2-9b3076800c33f8382c38628f35717951 unix-2.7.0.1-f8658ba9ec1c4fba8a371a8e0f42ec6c hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/Cabal-1.18.1.5/Cabal.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/Cabal-1.18.1.5 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: template-haskell version: 2.9.0.0 id: template-haskell-2.9.0.0-6d27c2b362b15abb1822f2f34b9ae7f9 license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: package-url: synopsis: Support library for Template Haskell description: This package provides modules containing facilities for manipulating Haskell source code using Template Haskell. . See for more information. category: Template Haskell author: exposed: True exposed-modules: Language.Haskell.TH Language.Haskell.TH.Lib Language.Haskell.TH.Ppr Language.Haskell.TH.PprLib Language.Haskell.TH.Quote Language.Haskell.TH.Syntax hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/template-haskell-2.9.0.0 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/template-haskell-2.9.0.0 hs-libraries: HStemplate-haskell-2.9.0.0 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 containers-0.5.5.1-d4bd887fb97aa3a46cbadc13709b7653 pretty-1.1.1.1-0984f47ffe93ef3983c80b96280f1c3a hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/template-haskell-2.9.0.0/template-haskell.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/template-haskell-2.9.0.0 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: pretty version: 1.1.1.1 id: pretty-1.1.1.1-0984f47ffe93ef3983c80b96280f1c3a license: BSD3 copyright: maintainer: David Terei stability: Stable homepage: http://github.com/haskell/pretty package-url: synopsis: Pretty-printing library description: This package contains a pretty-printing library, a set of API's that provides a way to easily print out text in a consistent format of your choosing. This is useful for compilers and related tools. . This library was originally designed by John Hughes's and has since been heavily modified by Simon Peyton Jones. category: Text author: exposed: True exposed-modules: Text.PrettyPrint Text.PrettyPrint.HughesPJ hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/pretty-1.1.1.1 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/pretty-1.1.1.1 hs-libraries: HSpretty-1.1.1.1 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/pretty-1.1.1.1/pretty.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/pretty-1.1.1.1 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: hpc version: 0.6.0.1 id: hpc-0.6.0.1-cca17f12dab542e09c423a74a4590c5d license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: package-url: synopsis: Code Coverage Library for Haskell description: This package provides the code coverage library for Haskell. . See for more information. category: Control author: Andy Gill exposed: True exposed-modules: Trace.Hpc.Util Trace.Hpc.Mix Trace.Hpc.Tix Trace.Hpc.Reflect hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/hpc-0.6.0.1 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/hpc-0.6.0.1 hs-libraries: HShpc-0.6.0.1 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 containers-0.5.5.1-d4bd887fb97aa3a46cbadc13709b7653 directory-1.2.1.0-07cd1f59e3c6cac5e3e180019c59a115 time-1.4.2-9b3076800c33f8382c38628f35717951 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/hpc-0.6.0.1/hpc.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/hpc-0.6.0.1 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: process version: 1.2.0.0 id: process-1.2.0.0-06c3215a79834ce4886ae686a0f81122 license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: package-url: synopsis: Process libraries description: This package contains libraries for dealing with system processes. category: System author: exposed: True exposed-modules: System.Cmd System.Process System.Process.Internals hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/process-1.2.0.0 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/process-1.2.0.0 hs-libraries: HSprocess-1.2.0.0 extra-libraries: extra-ghci-libraries: include-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/process-1.2.0.0/include includes: runProcess.h depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 deepseq-1.3.0.2-63a1ab91b7017a28bb5d04cb1b5d2d02 directory-1.2.1.0-07cd1f59e3c6cac5e3e180019c59a115 filepath-1.3.0.2-25a474a9272ae6260626ce0d70ad1cab unix-2.7.0.1-f8658ba9ec1c4fba8a371a8e0f42ec6c hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/process-1.2.0.0/process.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/process-1.2.0.0 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: directory version: 1.2.1.0 id: directory-1.2.1.0-07cd1f59e3c6cac5e3e180019c59a115 license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: package-url: synopsis: library for directory handling description: This package provides a library for handling directories. category: System author: exposed: True exposed-modules: System.Directory hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/directory-1.2.1.0 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/directory-1.2.1.0 hs-libraries: HSdirectory-1.2.1.0 extra-libraries: extra-ghci-libraries: include-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/directory-1.2.1.0/include includes: HsDirectory.h depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 filepath-1.3.0.2-25a474a9272ae6260626ce0d70ad1cab time-1.4.2-9b3076800c33f8382c38628f35717951 unix-2.7.0.1-f8658ba9ec1c4fba8a371a8e0f42ec6c hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/directory-1.2.1.0/directory.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/directory-1.2.1.0 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: unix version: 2.7.0.1 id: unix-2.7.0.1-f8658ba9ec1c4fba8a371a8e0f42ec6c license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: package-url: synopsis: POSIX functionality description: This package gives you access to the set of operating system services standardised by POSIX 1003.1b (or the IEEE Portable Operating System Interface for Computing Environments - IEEE Std. 1003.1). . The package is not supported under Windows (except under Cygwin). category: System author: exposed: True exposed-modules: System.Posix System.Posix.ByteString System.Posix.Error System.Posix.Resource System.Posix.Time System.Posix.Unistd System.Posix.User System.Posix.Signals System.Posix.Signals.Exts System.Posix.Semaphore System.Posix.SharedMem System.Posix.ByteString.FilePath System.Posix.Directory System.Posix.Directory.ByteString System.Posix.DynamicLinker.Module System.Posix.DynamicLinker.Module.ByteString System.Posix.DynamicLinker.Prim System.Posix.DynamicLinker.ByteString System.Posix.DynamicLinker System.Posix.Files System.Posix.Files.ByteString System.Posix.IO System.Posix.IO.ByteString System.Posix.Env System.Posix.Env.ByteString System.Posix.Process System.Posix.Process.Internals System.Posix.Process.ByteString System.Posix.Temp System.Posix.Temp.ByteString System.Posix.Terminal System.Posix.Terminal.ByteString hidden-modules: System.Posix.Directory.Common System.Posix.DynamicLinker.Common System.Posix.Files.Common System.Posix.IO.Common System.Posix.Process.Common System.Posix.Terminal.Common trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/unix-2.7.0.1 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/unix-2.7.0.1 hs-libraries: HSunix-2.7.0.1 extra-libraries: rt util dl pthread extra-ghci-libraries: include-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/unix-2.7.0.1/include includes: HsUnix.h execvpe.h depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 bytestring-0.10.4.0-d6f1d17d717e8652498cab8269a0acd5 time-1.4.2-9b3076800c33f8382c38628f35717951 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/unix-2.7.0.1/unix.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/unix-2.7.0.1 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: time version: 1.4.2 id: time-1.4.2-9b3076800c33f8382c38628f35717951 license: BSD3 copyright: maintainer: stability: stable homepage: http://semantic.org/TimeLib/ package-url: synopsis: A time library description: A time library category: System author: Ashley Yakeley exposed: True exposed-modules: Data.Time.Calendar Data.Time.Calendar.MonthDay Data.Time.Calendar.OrdinalDate Data.Time.Calendar.WeekDate Data.Time.Calendar.Julian Data.Time.Calendar.Easter Data.Time.Clock Data.Time.Clock.POSIX Data.Time.Clock.TAI Data.Time.LocalTime Data.Time.Format Data.Time hidden-modules: Data.Time.Calendar.Private Data.Time.Calendar.Days Data.Time.Calendar.Gregorian Data.Time.Calendar.JulianYearDay Data.Time.Clock.Scale Data.Time.Clock.UTC Data.Time.Clock.CTimeval Data.Time.Clock.UTCDiff Data.Time.LocalTime.TimeZone Data.Time.LocalTime.TimeOfDay Data.Time.LocalTime.LocalTime Data.Time.Format.Parse trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/time-1.4.2 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/time-1.4.2 hs-libraries: HStime-1.4.2 extra-libraries: extra-ghci-libraries: include-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/time-1.4.2/include includes: depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 deepseq-1.3.0.2-63a1ab91b7017a28bb5d04cb1b5d2d02 old-locale-1.0.0.6-50b0125c49f76af85dc7aa22975cdc34 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/time-1.4.2/time.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/time-1.4.2 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: old-locale version: 1.0.0.6 id: old-locale-1.0.0.6-50b0125c49f76af85dc7aa22975cdc34 license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: package-url: synopsis: locale library description: This package provides the ability to adapt to locale conventions such as date and time formats. category: System author: exposed: True exposed-modules: System.Locale hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/old-locale-1.0.0.6 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/old-locale-1.0.0.6 hs-libraries: HSold-locale-1.0.0.6 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/old-locale-1.0.0.6/old-locale.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/old-locale-1.0.0.6 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: containers version: 0.5.5.1 id: containers-0.5.5.1-d4bd887fb97aa3a46cbadc13709b7653 license: BSD3 copyright: maintainer: fox@ucw.cz stability: homepage: package-url: synopsis: Assorted concrete container types description: This package contains efficient general-purpose implementations of various basic immutable container types. The declared cost of each operation is either worst-case or amortized, but remains valid even if structures are shared. category: Data Structures author: exposed: True exposed-modules: Data.IntMap Data.IntMap.Lazy Data.IntMap.Strict Data.IntSet Data.Map Data.Map.Lazy Data.Map.Strict Data.Set Data.Graph Data.Sequence Data.Tree hidden-modules: Data.BitUtil Data.IntMap.Base Data.IntSet.Base Data.Map.Base Data.Set.Base Data.StrictPair trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/containers-0.5.5.1 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/containers-0.5.5.1 hs-libraries: HScontainers-0.5.5.1 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 deepseq-1.3.0.2-63a1ab91b7017a28bb5d04cb1b5d2d02 ghc-prim-0.3.1.0-a24f9c14c632d75b683d0f93283aea37 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/containers-0.5.5.1/containers.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/containers-0.5.5.1 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: bytestring version: 0.10.4.0 id: bytestring-0.10.4.0-d6f1d17d717e8652498cab8269a0acd5 license: BSD3 copyright: Copyright (c) Don Stewart 2005-2009, (c) Duncan Coutts 2006-2013, (c) David Roundy 2003-2005, (c) Jasper Van der Jeugt 2010, (c) Simon Meier 2010-2013. maintainer: Don Stewart , Duncan Coutts stability: homepage: https://github.com/haskell/bytestring package-url: synopsis: Fast, compact, strict and lazy byte strings with a list interface description: An efficient compact, immutable byte string type (both strict and lazy) suitable for binary or 8-bit character data. . The 'ByteString' type represents sequences of bytes or 8-bit characters. It is suitable for high performance use, both in terms of large data quantities, or high speed requirements. The 'ByteString' functions follow the same style as Haskell\'s ordinary lists, so it is easy to convert code from using 'String' to 'ByteString'. . Two 'ByteString' variants are provided: . * Strict 'ByteString's keep the string as a single large array. This makes them convenient for passing data between C and Haskell. . * Lazy 'ByteString's use a lazy list of strict chunks which makes it suitable for I\/O streaming tasks. . The @Char8@ modules provide a character-based view of the same underlying 'ByteString' types. This makes it convenient to handle mixed binary and 8-bit character content (which is common in many file formats and network protocols). . The 'Builder' module provides an efficient way to build up 'ByteString's in an ad-hoc way by repeated concatenation. This is ideal for fast serialisation or pretty printing. . There is also a 'ShortByteString' type which has a lower memory overhead and can can be converted to or from a 'ByteString', but supports very few other operations. It is suitable for keeping many short strings in memory. . 'ByteString's are not designed for Unicode. For Unicode strings you should use the 'Text' type from the @text@ package. . These modules are intended to be imported qualified, to avoid name clashes with "Prelude" functions, e.g. . > import qualified Data.ByteString as BS category: Data author: Don Stewart, Duncan Coutts exposed: True exposed-modules: Data.ByteString Data.ByteString.Char8 Data.ByteString.Unsafe Data.ByteString.Internal Data.ByteString.Lazy Data.ByteString.Lazy.Char8 Data.ByteString.Lazy.Internal Data.ByteString.Short Data.ByteString.Short.Internal Data.ByteString.Builder Data.ByteString.Builder.Extra Data.ByteString.Builder.Prim Data.ByteString.Builder.Internal Data.ByteString.Builder.Prim.Internal Data.ByteString.Lazy.Builder Data.ByteString.Lazy.Builder.Extras Data.ByteString.Lazy.Builder.ASCII hidden-modules: Data.ByteString.Builder.ASCII Data.ByteString.Builder.Prim.Binary Data.ByteString.Builder.Prim.ASCII Data.ByteString.Builder.Prim.Internal.Floating Data.ByteString.Builder.Prim.Internal.UncheckedShifts Data.ByteString.Builder.Prim.Internal.Base16 trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/bytestring-0.10.4.0 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/bytestring-0.10.4.0 hs-libraries: HSbytestring-0.10.4.0 extra-libraries: extra-ghci-libraries: include-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/bytestring-0.10.4.0/include includes: fpstring.h depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 deepseq-1.3.0.2-63a1ab91b7017a28bb5d04cb1b5d2d02 ghc-prim-0.3.1.0-a24f9c14c632d75b683d0f93283aea37 integer-gmp-0.5.1.0-26579559b3647acf4f01d5edd9491a46 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/bytestring-0.10.4.0/bytestring.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/bytestring-0.10.4.0 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: deepseq version: 1.3.0.2 id: deepseq-1.3.0.2-63a1ab91b7017a28bb5d04cb1b5d2d02 license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: package-url: synopsis: Deep evaluation of data structures description: This package provides methods for fully evaluating data structures (\"deep evaluation\"). Deep evaluation is often used for adding strictness to a program, e.g. in order to force pending exceptions, remove space leaks, or force lazy I/O to happen. It is also useful in parallel programs, to ensure pending work does not migrate to the wrong thread. . The primary use of this package is via the 'deepseq' function, a \"deep\" version of 'seq'. It is implemented on top of an 'NFData' typeclass (\"Normal Form Data\", data structures with no unevaluated components) which defines strategies for fully evaluating different data types. . If you want to automatically derive 'NFData' instances via the "GHC.Generics" facility, there is a companion package which builds on top of this package. category: Control author: exposed: True exposed-modules: Control.DeepSeq hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/deepseq-1.3.0.2 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/deepseq-1.3.0.2 hs-libraries: HSdeepseq-1.3.0.2 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/deepseq-1.3.0.2/deepseq.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/deepseq-1.3.0.2 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: array version: 0.5.0.0 id: array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: package-url: synopsis: Mutable and immutable arrays description: In addition to providing the "Data.Array" module , this package also defines the classes 'IArray' of immutable arrays and 'MArray' of arrays mutable within appropriate monads, as well as some instances of these classes. category: Data Structures author: exposed: True exposed-modules: Data.Array Data.Array.Base Data.Array.IArray Data.Array.IO Data.Array.IO.Safe Data.Array.IO.Internals Data.Array.MArray Data.Array.MArray.Safe Data.Array.ST Data.Array.ST.Safe Data.Array.Storable Data.Array.Storable.Safe Data.Array.Storable.Internals Data.Array.Unboxed Data.Array.Unsafe hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/array-0.5.0.0 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/array-0.5.0.0 hs-libraries: HSarray-0.5.0.0 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/array-0.5.0.0/array.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/array-0.5.0.0 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: filepath version: 1.3.0.2 id: filepath-1.3.0.2-25a474a9272ae6260626ce0d70ad1cab license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: http://www-users.cs.york.ac.uk/~ndm/filepath/ package-url: synopsis: Library for manipulating FilePaths in a cross platform way. description: A library for 'FilePath' manipulations, using Posix or Windows filepaths depending on the platform. . Both "System.FilePath.Posix" and "System.FilePath.Windows" provide the same interface. See either for examples and a list of the available functions. category: System author: Neil Mitchell exposed: True exposed-modules: System.FilePath System.FilePath.Posix System.FilePath.Windows hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/filepath-1.3.0.2 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/filepath-1.3.0.2 hs-libraries: HSfilepath-1.3.0.2 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/filepath-1.3.0.2/filepath.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/filepath-1.3.0.2 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: base version: 4.7.0.2 id: base-4.7.0.2-bfd89587617e381ae01b8dd7b6c7f1c1 license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: package-url: synopsis: Basic libraries description: This package contains the "Prelude" and its support libraries, and a large collection of useful libraries ranging from data structures to parsing combinators and debugging utilities. category: Prelude author: exposed: True exposed-modules: Control.Applicative Control.Arrow Control.Category Control.Concurrent Control.Concurrent.Chan Control.Concurrent.MVar Control.Concurrent.QSem Control.Concurrent.QSemN Control.Exception Control.Exception.Base Control.Monad Control.Monad.Fix Control.Monad.Instances Control.Monad.ST Control.Monad.ST.Lazy Control.Monad.ST.Lazy.Safe Control.Monad.ST.Lazy.Unsafe Control.Monad.ST.Safe Control.Monad.ST.Strict Control.Monad.ST.Unsafe Control.Monad.Zip Data.Bits Data.Bool Data.Char Data.Coerce Data.Complex Data.Data Data.Dynamic Data.Either Data.Eq Data.Fixed Data.Foldable Data.Function Data.Functor Data.IORef Data.Int Data.Ix Data.List Data.Maybe Data.Monoid Data.OldTypeable Data.OldTypeable.Internal Data.Ord Data.Proxy Data.Ratio Data.STRef Data.STRef.Lazy Data.STRef.Strict Data.String Data.Traversable Data.Tuple Data.Type.Bool Data.Type.Coercion Data.Type.Equality Data.Typeable Data.Typeable.Internal Data.Unique Data.Version Data.Word Debug.Trace Foreign Foreign.C Foreign.C.Error Foreign.C.String Foreign.C.Types Foreign.Concurrent Foreign.ForeignPtr Foreign.ForeignPtr.Safe Foreign.ForeignPtr.Unsafe Foreign.Marshal Foreign.Marshal.Alloc Foreign.Marshal.Array Foreign.Marshal.Error Foreign.Marshal.Pool Foreign.Marshal.Safe Foreign.Marshal.Unsafe Foreign.Marshal.Utils Foreign.Ptr Foreign.Safe Foreign.StablePtr Foreign.Storable GHC.Arr GHC.Base GHC.Char GHC.Conc GHC.Conc.IO GHC.Conc.Signal GHC.Conc.Sync GHC.ConsoleHandler GHC.Constants GHC.Desugar GHC.Enum GHC.Environment GHC.Err GHC.Exception GHC.Exts GHC.Fingerprint GHC.Fingerprint.Type GHC.Float GHC.Float.ConversionUtils GHC.Float.RealFracMethods GHC.Foreign GHC.ForeignPtr GHC.GHCi GHC.Generics GHC.IO GHC.IO.Buffer GHC.IO.BufferedIO GHC.IO.Device GHC.IO.Encoding GHC.IO.Encoding.CodePage GHC.IO.Encoding.Failure GHC.IO.Encoding.Iconv GHC.IO.Encoding.Latin1 GHC.IO.Encoding.Types GHC.IO.Encoding.UTF16 GHC.IO.Encoding.UTF32 GHC.IO.Encoding.UTF8 GHC.IO.Exception GHC.IO.FD GHC.IO.Handle GHC.IO.Handle.FD GHC.IO.Handle.Internals GHC.IO.Handle.Text GHC.IO.Handle.Types GHC.IO.IOMode GHC.IOArray GHC.IORef GHC.IP GHC.Int GHC.List GHC.MVar GHC.Num GHC.PArr GHC.Pack GHC.Profiling GHC.Ptr GHC.Read GHC.Real GHC.ST GHC.STRef GHC.Show GHC.Stable GHC.Stack GHC.Stats GHC.Storable GHC.TopHandler GHC.TypeLits GHC.Unicode GHC.Weak GHC.Word Numeric Prelude System.CPUTime System.Console.GetOpt System.Environment System.Exit System.IO System.IO.Error System.IO.Unsafe System.Info System.Mem System.Mem.StableName System.Mem.Weak System.Posix.Internals System.Posix.Types System.Timeout Text.ParserCombinators.ReadP Text.ParserCombinators.ReadPrec Text.Printf Text.Read Text.Read.Lex Text.Show Text.Show.Functions Unsafe.Coerce GHC.Event hidden-modules: Control.Monad.ST.Imp Control.Monad.ST.Lazy.Imp Foreign.ForeignPtr.Imp System.Environment.ExecutablePath GHC.Event.Arr GHC.Event.Array GHC.Event.Clock GHC.Event.Control GHC.Event.EPoll GHC.Event.IntTable GHC.Event.Internal GHC.Event.KQueue GHC.Event.Manager GHC.Event.PSQ GHC.Event.Poll GHC.Event.Thread GHC.Event.TimerManager GHC.Event.Unique trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/base-4.7.0.2 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/base-4.7.0.2 hs-libraries: HSbase-4.7.0.2 extra-libraries: extra-ghci-libraries: include-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/base-4.7.0.2/include includes: HsBase.h depends: ghc-prim-0.3.1.0-a24f9c14c632d75b683d0f93283aea37 integer-gmp-0.5.1.0-26579559b3647acf4f01d5edd9491a46 builtin_rts hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/base-4.7.0.2/base.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/base-4.7.0.2 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: integer-gmp version: 0.5.1.0 id: integer-gmp-0.5.1.0-26579559b3647acf4f01d5edd9491a46 license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: package-url: synopsis: Integer library based on GMP description: This package provides the low-level implementation of the standard 'Integer' type based on the . . This package provides access to the internal representation of 'Integer' as well as primitive operations with no proper error handling, and should only be used directly with the utmost care. . For more details about the design of @integer-gmp@, see . category: Numerical author: exposed: True exposed-modules: GHC.Integer GHC.Integer.GMP.Internals GHC.Integer.GMP.Prim GHC.Integer.Logarithms GHC.Integer.Logarithms.Internals hidden-modules: GHC.Integer.Type trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/integer-gmp-0.5.1.0 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/integer-gmp-0.5.1.0 hs-libraries: HSinteger-gmp-0.5.1.0 extra-libraries: gmp extra-ghci-libraries: include-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/integer-gmp-0.5.1.0/include includes: depends: ghc-prim-0.3.1.0-a24f9c14c632d75b683d0f93283aea37 hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/integer-gmp-0.5.1.0/integer-gmp.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/integer-gmp-0.5.1.0 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: ghc-prim version: 0.3.1.0 id: ghc-prim-0.3.1.0-a24f9c14c632d75b683d0f93283aea37 license: BSD3 copyright: maintainer: libraries@haskell.org stability: homepage: package-url: synopsis: GHC primitives description: GHC primitives. category: GHC author: exposed: True exposed-modules: GHC.CString GHC.Classes GHC.Debug GHC.IntWord64 GHC.Magic GHC.PrimopWrappers GHC.Tuple GHC.Types GHC.Prim hidden-modules: trusted: False import-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/ghc-prim-0.3.1.0 library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/ghc-prim-0.3.1.0 hs-libraries: HSghc-prim-0.3.1.0 extra-libraries: extra-ghci-libraries: include-dirs: includes: depends: builtin_rts hugs-options: cc-options: ld-options: framework-dirs: frameworks: haddock-interfaces: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/ghc-prim-0.3.1.0/ghc-prim.haddock haddock-html: /opt/ghc/7.8.4/share/doc/ghc/html/libraries/ghc-prim-0.3.1.0 pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" --- name: rts version: 1.0 id: builtin_rts license: BSD3 copyright: maintainer: glasgow-haskell-users@haskell.org stability: homepage: package-url: synopsis: description: category: author: exposed: True exposed-modules: hidden-modules: trusted: False import-dirs: library-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/rts-1.0 hs-libraries: HSrts Cffi extra-libraries: m rt dl extra-ghci-libraries: include-dirs: /opt/ghc/7.8.4/lib/ghc-7.8.4/include includes: Stg.h depends: hugs-options: cc-options: ld-options: "-Wl,-u,ghczmprim_GHCziTypes_Izh_static_info" "-Wl,-u,ghczmprim_GHCziTypes_Czh_static_info" "-Wl,-u,ghczmprim_GHCziTypes_Fzh_static_info" "-Wl,-u,ghczmprim_GHCziTypes_Dzh_static_info" "-Wl,-u,base_GHCziPtr_Ptr_static_info" "-Wl,-u,ghczmprim_GHCziTypes_Wzh_static_info" "-Wl,-u,base_GHCziInt_I8zh_static_info" "-Wl,-u,base_GHCziInt_I16zh_static_info" "-Wl,-u,base_GHCziInt_I32zh_static_info" "-Wl,-u,base_GHCziInt_I64zh_static_info" "-Wl,-u,base_GHCziWord_W8zh_static_info" "-Wl,-u,base_GHCziWord_W16zh_static_info" "-Wl,-u,base_GHCziWord_W32zh_static_info" "-Wl,-u,base_GHCziWord_W64zh_static_info" "-Wl,-u,base_GHCziStable_StablePtr_static_info" "-Wl,-u,ghczmprim_GHCziTypes_Izh_con_info" "-Wl,-u,ghczmprim_GHCziTypes_Czh_con_info" "-Wl,-u,ghczmprim_GHCziTypes_Fzh_con_info" "-Wl,-u,ghczmprim_GHCziTypes_Dzh_con_info" "-Wl,-u,base_GHCziPtr_Ptr_con_info" "-Wl,-u,base_GHCziPtr_FunPtr_con_info" "-Wl,-u,base_GHCziStable_StablePtr_con_info" "-Wl,-u,ghczmprim_GHCziTypes_False_closure" "-Wl,-u,ghczmprim_GHCziTypes_True_closure" "-Wl,-u,base_GHCziPack_unpackCString_closure" "-Wl,-u,base_GHCziIOziException_stackOverflow_closure" "-Wl,-u,base_GHCziIOziException_heapOverflow_closure" "-Wl,-u,base_ControlziExceptionziBase_nonTermination_closure" "-Wl,-u,base_GHCziIOziException_blockedIndefinitelyOnMVar_closure" "-Wl,-u,base_GHCziIOziException_blockedIndefinitelyOnSTM_closure" "-Wl,-u,base_ControlziExceptionziBase_nestedAtomically_closure" "-Wl,-u,base_GHCziWeak_runFinalizzerBatch_closure" "-Wl,-u,base_GHCziTopHandler_flushStdHandles_closure" "-Wl,-u,base_GHCziTopHandler_runIO_closure" "-Wl,-u,base_GHCziTopHandler_runNonIO_closure" "-Wl,-u,base_GHCziConcziIO_ensureIOManagerIsRunning_closure" "-Wl,-u,base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure" "-Wl,-u,base_GHCziConcziSync_runSparks_closure" "-Wl,-u,base_GHCziConcziSignal_runHandlersPtr_closure" framework-dirs: frameworks: haddock-interfaces: haddock-html: pkgroot: "/opt/ghc/7.8.4/lib/ghc-7.8.4" stack-1.1.2/test/package-dump/ghc-7.8.4-osx.txt0000644000000000000000000000625712541771406017131 0ustar0000000000000000name: hmatrix version: 0.16.1.5 id: hmatrix-0.16.1.5-12d5d21f26aa98774cdd8edbc343fbfe license: BSD3 copyright: maintainer: Alberto Ruiz stability: provisional homepage: https://github.com/albertoruiz/hmatrix package-url: synopsis: Numeric Linear Algebra description: Linear algebra based on BLAS and LAPACK. . The package is organized as follows: . ["Numeric.LinearAlgebra.HMatrix"] Starting point and recommended import module for most applications. . ["Numeric.LinearAlgebra.Static"] Experimental alternative interface. . ["Numeric.LinearAlgebra.Devel"] Tools for extending the library. . (Other modules are exposed with hidden documentation for backwards compatibility.) . Code examples: category: Math author: Alberto Ruiz exposed: True exposed-modules: Data.Packed Data.Packed.Vector Data.Packed.Matrix Data.Packed.Foreign Data.Packed.ST Data.Packed.Development Numeric.LinearAlgebra Numeric.LinearAlgebra.LAPACK Numeric.LinearAlgebra.Algorithms Numeric.Container Numeric.LinearAlgebra.Util Numeric.LinearAlgebra.Devel Numeric.LinearAlgebra.Data Numeric.LinearAlgebra.HMatrix Numeric.LinearAlgebra.Static hidden-modules: Data.Packed.Internal Data.Packed.Internal.Common Data.Packed.Internal.Signatures Data.Packed.Internal.Vector Data.Packed.Internal.Matrix Data.Packed.IO Numeric.Chain Numeric.Vectorized Numeric.Vector Numeric.Matrix Data.Packed.Internal.Numeric Data.Packed.Numeric Numeric.LinearAlgebra.Util.Convolution Numeric.LinearAlgebra.Util.CG Numeric.LinearAlgebra.Random Numeric.Conversion Numeric.Sparse Numeric.LinearAlgebra.Static.Internal trusted: False import-dirs: /Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/lib/x86_64-osx-ghc-7.8.4/hmatrix-0.16.1.5 library-dirs: /Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/lib/x86_64-osx-ghc-7.8.4/hmatrix-0.16.1.5 /opt/local/lib/ /usr/local/lib/ "C:/Program Files/Example/" hs-libraries: HShmatrix-0.16.1.5 extra-libraries: blas lapack extra-ghci-libraries: include-dirs: /opt/local/include/ /usr/local/include/ includes: depends: array-0.5.0.0-470385a50d2b78598af85cfe9d988e1b base-4.7.0.2-918c7ac27f65a87103264a9f51652d63 binary-0.7.1.0-108d06eea2ef05e517f9c1facf10f63c bytestring-0.10.4.0-78bc8f2c724c765c78c004a84acf6cc3 deepseq-1.3.0.2-0ddc77716bd2515426e1ba39f6788a4f random-1.1-822c19b7507b6ac1aaa4c66731e775ae split-0.2.2-34cfb851cc3784e22bfae7a7bddda9c5 storable-complex-0.2.2-e962c368d58acc1f5b41d41edc93da72 vector-0.10.12.3-f4222db607fd5fdd7545d3e82419b307 hugs-options: cc-options: ld-options: framework-dirs: frameworks: Accelerate haddock-interfaces: /Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/doc/html/hmatrix.haddock haddock-html: /Users/alexbiehl/.stack/snapshots/x86_64-osx/lts-2.13/7.8.4/doc/html stack-1.1.2/test/package-dump/ghc-7.10.txt0000644000000000000000000015720712534327003016223 0ustar0000000000000000name: ghc version: 7.10.1 id: ghc-7.10.1-325809317787a897b7a97d646ceaa3a3 key: ghc_EMlWrQ42XY0BNVbSrKixqY license: BSD3 maintainer: glasgow-haskell-users@haskell.org homepage: http://www.haskell.org/ghc/ synopsis: The GHC API description: GHC's functionality can be useful for more things than just compiling Haskell programs. Important use cases are programs that analyse (and perhaps transform) Haskell code. Others include loading Haskell code dynamically in a GHCi-like manner. For this reason, a lot of GHC's functionality is made available through this package. category: Development author: The GHC Team exposed: False exposed-modules: Avail BasicTypes ConLike DataCon PatSyn Demand Debug Exception GhcMonad Hooks Id IdInfo Lexeme Literal Llvm Llvm.AbsSyn Llvm.MetaData Llvm.PpLlvm Llvm.Types LlvmCodeGen LlvmCodeGen.Base LlvmCodeGen.CodeGen LlvmCodeGen.Data LlvmCodeGen.Ppr LlvmCodeGen.Regs LlvmMangler MkId Module Name NameEnv NameSet OccName RdrName SrcLoc UniqSupply Unique Var VarEnv VarSet UnVarGraph BlockId CLabel Cmm CmmBuildInfoTables CmmPipeline CmmCallConv CmmCommonBlockElim CmmContFlowOpt CmmExpr CmmInfo CmmLex CmmLint CmmLive CmmMachOp CmmNode CmmOpt CmmParse CmmProcPoint CmmSink CmmType CmmUtils CmmLayoutStack MkGraph PprBase PprC PprCmm PprCmmDecl PprCmmExpr Bitmap CodeGen.Platform CodeGen.Platform.ARM CodeGen.Platform.ARM64 CodeGen.Platform.NoRegs CodeGen.Platform.PPC CodeGen.Platform.PPC_Darwin CodeGen.Platform.SPARC CodeGen.Platform.X86 CodeGen.Platform.X86_64 CgUtils StgCmm StgCmmBind StgCmmClosure StgCmmCon StgCmmEnv StgCmmExpr StgCmmForeign StgCmmHeap StgCmmHpc StgCmmArgRep StgCmmLayout StgCmmMonad StgCmmPrim StgCmmProf StgCmmTicky StgCmmUtils StgCmmExtCode SMRep CoreArity CoreFVs CoreLint CorePrep CoreSubst CoreSyn TrieMap CoreTidy CoreUnfold CoreUtils MkCore PprCore Check Coverage Desugar DsArrows DsBinds DsCCall DsExpr DsForeign DsGRHSs DsListComp DsMonad DsUtils Match MatchCon MatchLit HsBinds HsDecls HsDoc HsExpr HsImpExp HsLit PlaceHolder HsPat HsSyn HsTypes HsUtils BinIface BuildTyCl IfaceEnv IfaceSyn IfaceType LoadIface MkIface TcIface FlagChecker Annotations BreakArray CmdLineParser CodeOutput Config Constants DriverMkDepend DriverPhases PipelineMonad DriverPipeline DynFlags ErrUtils Finder GHC GhcMake GhcPlugins DynamicLoading HeaderInfo HscMain HscStats HscTypes InteractiveEval InteractiveEvalTypes PackageConfig Packages PlatformConstants Plugins TcPluginM PprTyThing StaticFlags StaticPtrTable SysTools TidyPgm Ctype HaddockUtils Lexer OptCoercion Parser RdrHsSyn ApiAnnotation ForeignCall PrelInfo PrelNames PrelRules PrimOp TysPrim TysWiredIn CostCentre ProfInit SCCfinal RnBinds RnEnv RnExpr RnHsDoc RnNames RnPat RnSource RnSplice RnTypes CoreMonad CSE FloatIn FloatOut LiberateCase OccurAnal SAT SetLevels SimplCore SimplEnv SimplMonad SimplUtils Simplify SimplStg StgStats UnariseStg Rules SpecConstr Specialise CoreToStg StgLint StgSyn CallArity DmdAnal WorkWrap WwLib FamInst Inst TcAnnotations TcArrows TcBinds TcClassDcl TcDefaults TcDeriv TcEnv TcExpr TcForeign TcGenDeriv TcGenGenerics TcHsSyn TcHsType TcInstDcls TcMType TcValidity TcMatches TcPat TcPatSyn TcRnDriver TcRnMonad TcRnTypes TcRules TcSimplify TcErrors TcTyClsDecls TcTyDecls TcType TcEvidence TcUnify TcInteract TcCanonical TcFlatten TcSMonad TcTypeNats TcSplice Class Coercion FamInstEnv FunDeps InstEnv TyCon CoAxiom Kind Type TypeRep Unify Bag Binary BooleanFormula BufWrite Digraph Encoding FastBool FastFunctions FastMutInt FastString FastTypes Fingerprint FiniteMap GraphBase GraphColor GraphOps GraphPpr IOEnv ListSetOps Maybes MonadUtils OrdList Outputable Pair Panic Pretty Serialized State Stream StringBuffer UniqFM UniqSet Util ExtsCompat46 Vectorise.Builtins.Base Vectorise.Builtins.Initialise Vectorise.Builtins Vectorise.Monad.Base Vectorise.Monad.Naming Vectorise.Monad.Local Vectorise.Monad.Global Vectorise.Monad.InstEnv Vectorise.Monad Vectorise.Utils.Base Vectorise.Utils.Closure Vectorise.Utils.Hoisting Vectorise.Utils.PADict Vectorise.Utils.Poly Vectorise.Utils Vectorise.Generic.Description Vectorise.Generic.PAMethods Vectorise.Generic.PADict Vectorise.Generic.PData Vectorise.Type.Env Vectorise.Type.Type Vectorise.Type.TyConDecl Vectorise.Type.Classify Vectorise.Convert Vectorise.Vect Vectorise.Var Vectorise.Env Vectorise.Exp Vectorise Hoopl.Dataflow Hoopl AsmCodeGen TargetReg NCGMonad Instruction Size Reg RegClass PIC Platform CPrim X86.Regs X86.RegInfo X86.Instr X86.Cond X86.Ppr X86.CodeGen PPC.Regs PPC.RegInfo PPC.Instr PPC.Cond PPC.Ppr PPC.CodeGen SPARC.Base SPARC.Regs SPARC.Imm SPARC.AddrMode SPARC.Cond SPARC.Instr SPARC.Stack SPARC.ShortcutJump SPARC.Ppr SPARC.CodeGen SPARC.CodeGen.Amode SPARC.CodeGen.Base SPARC.CodeGen.CondCode SPARC.CodeGen.Gen32 SPARC.CodeGen.Gen64 SPARC.CodeGen.Sanity SPARC.CodeGen.Expand RegAlloc.Liveness RegAlloc.Graph.Main RegAlloc.Graph.Stats RegAlloc.Graph.ArchBase RegAlloc.Graph.ArchX86 RegAlloc.Graph.Coalesce RegAlloc.Graph.Spill RegAlloc.Graph.SpillClean RegAlloc.Graph.SpillCost RegAlloc.Graph.TrivColorable RegAlloc.Linear.Main RegAlloc.Linear.JoinToTargets RegAlloc.Linear.State RegAlloc.Linear.Stats RegAlloc.Linear.FreeRegs RegAlloc.Linear.StackMap RegAlloc.Linear.Base RegAlloc.Linear.X86.FreeRegs RegAlloc.Linear.X86_64.FreeRegs RegAlloc.Linear.PPC.FreeRegs RegAlloc.Linear.SPARC.FreeRegs Dwarf Dwarf.Types Dwarf.Constants DsMeta Convert ByteCodeAsm ByteCodeGen ByteCodeInstr ByteCodeItbls ByteCodeLink Debugger LibFFI Linker ObjLink RtClosureInspect DebuggerUtils trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/ghc_EMlWrQ42XY0BNVbSrKixqY library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/ghc_EMlWrQ42XY0BNVbSrKixqY data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/ghc-7.10.1 hs-libraries: HSghc-7.10.1-EMlWrQ42XY0BNVbSrKixqY include-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/ghc_EMlWrQ42XY0BNVbSrKixqY/include depends: array-0.5.1.0-e29cdbe82692341ebb7ce6e2798294f9 base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a bin-package-db-0.0.0.0-708fc7d634a370b311371a5bcde40b62 bytestring-0.10.6.0-0909f8f31271f3d75749190bf2ee35db containers-0.5.6.2-2114032c163425cc264e6e1169dc2f6d directory-1.2.2.0-b4959b472d9eee380c6b32291ade29e0 filepath-1.4.0.0-40d643aa87258c186441a1f8f3e13ca6 hoopl-3.10.0.2-8c8dfc4c3140e5f7c982da224c3cb1f0 hpc-0.6.0.2-ac9064885aa8cb08a93314222939ead4 process-1.2.3.0-3b1e9bca6ac38225806ff7bbf3f845b1 template-haskell-2.10.0.0-e895139a0ffff267d412e3d0191ce93b time-1.5.0.1-e17a9220d438435579d2914e90774246 transformers-0.4.2.0-c1a7bb855a176fe475d7b665301cd48f unix-2.7.1.0-e5915eb989e568b732bc7286b0d0817f haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/ghc-7.10.1/ghc.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/ghc-7.10.1 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: haskeline version: 0.7.2.1 id: haskeline-0.7.2.1-a646e1ddf1a755ca5b5775dcb2ef8d8b key: haske_IlDhIe25uAn0WJY379Nu1M license: BSD3 copyright: (c) Judah Jacobson maintainer: Judah Jacobson stability: Experimental homepage: http://trac.haskell.org/haskeline synopsis: A command-line interface for user input, written in Haskell. description: Haskeline provides a user interface for line input in command-line programs. This library is similar in purpose to readline, but since it is written in Haskell it is (hopefully) more easily used in other Haskell programs. . Haskeline runs both on POSIX-compatible systems and on Windows. category: User Interfaces author: Judah Jacobson exposed: True exposed-modules: System.Console.Haskeline System.Console.Haskeline.Completion System.Console.Haskeline.MonadException System.Console.Haskeline.History System.Console.Haskeline.IO hidden-modules: System.Console.Haskeline.Backend System.Console.Haskeline.Backend.WCWidth System.Console.Haskeline.Command System.Console.Haskeline.Command.Completion System.Console.Haskeline.Command.History System.Console.Haskeline.Command.KillRing System.Console.Haskeline.Directory System.Console.Haskeline.Emacs System.Console.Haskeline.InputT System.Console.Haskeline.Key System.Console.Haskeline.LineState System.Console.Haskeline.Monads System.Console.Haskeline.Prefs System.Console.Haskeline.RunCommand System.Console.Haskeline.Term System.Console.Haskeline.Command.Undo System.Console.Haskeline.Vi System.Console.Haskeline.Recover System.Console.Haskeline.Backend.Posix System.Console.Haskeline.Backend.Posix.Encoder System.Console.Haskeline.Backend.DumbTerm System.Console.Haskeline.Backend.Terminfo trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/haske_IlDhIe25uAn0WJY379Nu1M library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/haske_IlDhIe25uAn0WJY379Nu1M data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/haskeline-0.7.2.1 hs-libraries: HShaskeline-0.7.2.1-IlDhIe25uAn0WJY379Nu1M depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a bytestring-0.10.6.0-0909f8f31271f3d75749190bf2ee35db containers-0.5.6.2-2114032c163425cc264e6e1169dc2f6d directory-1.2.2.0-b4959b472d9eee380c6b32291ade29e0 filepath-1.4.0.0-40d643aa87258c186441a1f8f3e13ca6 terminfo-0.4.0.1-75199801b414a3f4c9de438be2a4e967 transformers-0.4.2.0-c1a7bb855a176fe475d7b665301cd48f unix-2.7.1.0-e5915eb989e568b732bc7286b0d0817f haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/haskeline-0.7.2.1/haskeline.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/haskeline-0.7.2.1 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: terminfo version: 0.4.0.1 id: terminfo-0.4.0.1-75199801b414a3f4c9de438be2a4e967 key: termi_7qZwBlx3clR8sTBilJl253 license: BSD3 copyright: (c) Judah Jacobson maintainer: Judah Jacobson stability: Stable homepage: https://github.com/judah/terminfo synopsis: Haskell bindings to the terminfo library. description: This library provides an interface to the terminfo database (via bindings to the curses library). allows POSIX systems to interact with a variety of terminals using a standard set of capabilities. category: User Interfaces author: Judah Jacobson exposed: True exposed-modules: System.Console.Terminfo System.Console.Terminfo.Base System.Console.Terminfo.Cursor System.Console.Terminfo.Color System.Console.Terminfo.Edit System.Console.Terminfo.Effects System.Console.Terminfo.Keys trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/termi_7qZwBlx3clR8sTBilJl253 library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/termi_7qZwBlx3clR8sTBilJl253 data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/terminfo-0.4.0.1 hs-libraries: HSterminfo-0.4.0.1-7qZwBlx3clR8sTBilJl253 extra-libraries: tinfo includes: ncurses.h term.h depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/terminfo-0.4.0.1/terminfo.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/terminfo-0.4.0.1 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: xhtml version: 3000.2.1 id: xhtml-3000.2.1-7de0560ea74b173b7313fc2303cc6c58 key: xhtml_0mVDYvYGgNUBWShvlDofr1 license: BSD3 copyright: Bjorn Bringert 2004-2006, Andy Gill and the Oregon Graduate Institute of Science and Technology, 1999-2001 maintainer: Chris Dornan stability: Stable homepage: https://github.com/haskell/xhtml synopsis: An XHTML combinator library description: This package provides combinators for producing XHTML 1.0, including the Strict, Transitional and Frameset variants. category: Web, XML, Pretty Printer author: Bjorn Bringert exposed: True exposed-modules: Text.XHtml Text.XHtml.Frameset Text.XHtml.Strict Text.XHtml.Transitional Text.XHtml.Debug Text.XHtml.Table hidden-modules: Text.XHtml.Strict.Attributes Text.XHtml.Strict.Elements Text.XHtml.Frameset.Attributes Text.XHtml.Frameset.Elements Text.XHtml.Transitional.Attributes Text.XHtml.Transitional.Elements Text.XHtml.BlockTable Text.XHtml.Extras Text.XHtml.Internals trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/xhtml_0mVDYvYGgNUBWShvlDofr1 library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/xhtml_0mVDYvYGgNUBWShvlDofr1 data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/xhtml-3000.2.1 hs-libraries: HSxhtml-3000.2.1-0mVDYvYGgNUBWShvlDofr1 depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/xhtml-3000.2.1/xhtml.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/xhtml-3000.2.1 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: transformers version: 0.4.2.0 id: transformers-0.4.2.0-c1a7bb855a176fe475d7b665301cd48f key: trans_ALYlebOVzVI4kxbFX5SGhm license: BSD3 maintainer: Ross Paterson synopsis: Concrete functor and monad transformers description: A portable library of functor and monad transformers, inspired by the paper \"Functional Programming with Overloading and Higher-Order Polymorphism\", by Mark P Jones, in /Advanced School of Functional Programming/, 1995 (). . This package contains: . * the monad transformer class (in "Control.Monad.Trans.Class") and IO monad class (in "Control.Monad.IO.Class") . * concrete functor and monad transformers, each with associated operations and functions to lift operations associated with other transformers. . The package can be used on its own in portable Haskell code, in which case operations need to be manually lifted through transformer stacks (see "Control.Monad.Trans.Class" for some examples). Alternatively, it can be used with the non-portable monad classes in the @mtl@ or @monads-tf@ packages, which automatically lift operations introduced by monad transformers through other transformers. category: Control author: Andy Gill, Ross Paterson exposed: True exposed-modules: Control.Applicative.Backwards Control.Applicative.Lift Control.Monad.IO.Class Control.Monad.Signatures Control.Monad.Trans.Class Control.Monad.Trans.Cont Control.Monad.Trans.Except Control.Monad.Trans.Error Control.Monad.Trans.Identity Control.Monad.Trans.List Control.Monad.Trans.Maybe Control.Monad.Trans.Reader Control.Monad.Trans.RWS Control.Monad.Trans.RWS.Lazy Control.Monad.Trans.RWS.Strict Control.Monad.Trans.State Control.Monad.Trans.State.Lazy Control.Monad.Trans.State.Strict Control.Monad.Trans.Writer Control.Monad.Trans.Writer.Lazy Control.Monad.Trans.Writer.Strict Data.Functor.Classes Data.Functor.Compose Data.Functor.Constant Data.Functor.Product Data.Functor.Reverse Data.Functor.Sum trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/trans_ALYlebOVzVI4kxbFX5SGhm library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/trans_ALYlebOVzVI4kxbFX5SGhm data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/transformers-0.4.2.0 hs-libraries: HStransformers-0.4.2.0-ALYlebOVzVI4kxbFX5SGhm depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/transformers-0.4.2.0/transformers.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/transformers-0.4.2.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: hoopl version: 3.10.0.2 id: hoopl-3.10.0.2-8c8dfc4c3140e5f7c982da224c3cb1f0 key: hoopl_JxODiSRz1e84NbH6nnZuUk license: BSD3 maintainer: nr@cs.tufts.edu homepage: http://ghc.cs.tufts.edu/hoopl/ synopsis: A library to support dataflow analysis and optimization description: Higher-order optimization library . See /Norman Ramsey, Joao Dias, and Simon Peyton Jones./ /(2010)/ for more details. category: Compilers/Interpreters author: Norman Ramsey, Joao Dias, Simon Marlow and Simon Peyton Jones exposed: True exposed-modules: Compiler.Hoopl Compiler.Hoopl.Internals Compiler.Hoopl.Wrappers Compiler.Hoopl.Passes.Dominator Compiler.Hoopl.Passes.DList hidden-modules: Compiler.Hoopl.Checkpoint Compiler.Hoopl.Collections Compiler.Hoopl.Combinators Compiler.Hoopl.Dataflow Compiler.Hoopl.Debug Compiler.Hoopl.Block Compiler.Hoopl.Graph Compiler.Hoopl.Label Compiler.Hoopl.MkGraph Compiler.Hoopl.Fuel Compiler.Hoopl.Pointed Compiler.Hoopl.Shape Compiler.Hoopl.Show Compiler.Hoopl.Unique Compiler.Hoopl.XUtil trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/hoopl_JxODiSRz1e84NbH6nnZuUk library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/hoopl_JxODiSRz1e84NbH6nnZuUk data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/hoopl-3.10.0.2 hs-libraries: HShoopl-3.10.0.2-JxODiSRz1e84NbH6nnZuUk depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a containers-0.5.6.2-2114032c163425cc264e6e1169dc2f6d haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/hoopl-3.10.0.2/hoopl.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/hoopl-3.10.0.2 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: bin-package-db version: 0.0.0.0 id: bin-package-db-0.0.0.0-708fc7d634a370b311371a5bcde40b62 key: binpa_JNoexmBMuO8C771QaIy3YN license: BSD3 maintainer: ghc-devs@haskell.org synopsis: The GHC compiler's view of the GHC package database format description: This library is shared between GHC and ghc-pkg and is used by GHC to read package databases. . It only deals with the subset of the package database that the compiler cares about: modules paths etc and not package metadata like description, authors etc. It is thus not a library interface to ghc-pkg and is *not* suitable for modifying GHC package databases. . The package database format and this library are constructed in such a way that while ghc-pkg depends on Cabal, the GHC library and program do not have to depend on Cabal. exposed: True exposed-modules: GHC.PackageDb trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/binpa_JNoexmBMuO8C771QaIy3YN library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/binpa_JNoexmBMuO8C771QaIy3YN data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/bin-package-db-0.0.0.0 hs-libraries: HSbin-package-db-0.0.0.0-JNoexmBMuO8C771QaIy3YN depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a binary-0.7.3.0-0f543654a1ae447e0d4d0bbfc1bb704e bytestring-0.10.6.0-0909f8f31271f3d75749190bf2ee35db directory-1.2.2.0-b4959b472d9eee380c6b32291ade29e0 filepath-1.4.0.0-40d643aa87258c186441a1f8f3e13ca6 haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/bin-package-db-0.0.0.0/bin-package-db.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/bin-package-db-0.0.0.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: Cabal version: 1.22.2.0 id: Cabal-1.22.2.0-9f7cae2e98cca225e3d159c1e1bc773c key: Cabal_HWT8QvVfJLn2ubvobpycJY license: BSD3 copyright: 2003-2006, Isaac Jones 2005-2011, Duncan Coutts maintainer: cabal-devel@haskell.org homepage: http://www.haskell.org/cabal/ synopsis: A framework for packaging Haskell software description: The Haskell Common Architecture for Building Applications and Libraries: a framework defining a common interface for authors to more easily build their Haskell applications in a portable way. . The Haskell Cabal is part of a larger infrastructure for distributing, organizing, and cataloging Haskell libraries and tools. category: Distribution author: Isaac Jones Duncan Coutts exposed: True exposed-modules: Distribution.Compat.CreatePipe Distribution.Compat.Environment Distribution.Compat.Exception Distribution.Compat.ReadP Distribution.Compiler Distribution.InstalledPackageInfo Distribution.License Distribution.Make Distribution.ModuleName Distribution.Package Distribution.PackageDescription Distribution.PackageDescription.Check Distribution.PackageDescription.Configuration Distribution.PackageDescription.Parse Distribution.PackageDescription.PrettyPrint Distribution.PackageDescription.Utils Distribution.ParseUtils Distribution.ReadE Distribution.Simple Distribution.Simple.Bench Distribution.Simple.Build Distribution.Simple.Build.Macros Distribution.Simple.Build.PathsModule Distribution.Simple.BuildPaths Distribution.Simple.BuildTarget Distribution.Simple.CCompiler Distribution.Simple.Command Distribution.Simple.Compiler Distribution.Simple.Configure Distribution.Simple.GHC Distribution.Simple.GHCJS Distribution.Simple.Haddock Distribution.Simple.HaskellSuite Distribution.Simple.Hpc Distribution.Simple.Install Distribution.Simple.InstallDirs Distribution.Simple.JHC Distribution.Simple.LHC Distribution.Simple.LocalBuildInfo Distribution.Simple.PackageIndex Distribution.Simple.PreProcess Distribution.Simple.PreProcess.Unlit Distribution.Simple.Program Distribution.Simple.Program.Ar Distribution.Simple.Program.Builtin Distribution.Simple.Program.Db Distribution.Simple.Program.Find Distribution.Simple.Program.GHC Distribution.Simple.Program.HcPkg Distribution.Simple.Program.Hpc Distribution.Simple.Program.Ld Distribution.Simple.Program.Run Distribution.Simple.Program.Script Distribution.Simple.Program.Strip Distribution.Simple.Program.Types Distribution.Simple.Register Distribution.Simple.Setup Distribution.Simple.SrcDist Distribution.Simple.Test Distribution.Simple.Test.ExeV10 Distribution.Simple.Test.LibV09 Distribution.Simple.Test.Log Distribution.Simple.UHC Distribution.Simple.UserHooks Distribution.Simple.Utils Distribution.System Distribution.TestSuite Distribution.Text Distribution.Utils.NubList Distribution.Verbosity Distribution.Version Language.Haskell.Extension hidden-modules: Distribution.Compat.Binary Distribution.Compat.CopyFile Distribution.Compat.TempFile Distribution.GetOpt Distribution.Simple.GHC.Internal Distribution.Simple.GHC.IPI641 Distribution.Simple.GHC.IPI642 Distribution.Simple.GHC.ImplInfo Paths_Cabal trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/Cabal_HWT8QvVfJLn2ubvobpycJY library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/Cabal_HWT8QvVfJLn2ubvobpycJY data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/Cabal-1.22.2.0 hs-libraries: HSCabal-1.22.2.0-HWT8QvVfJLn2ubvobpycJY depends: array-0.5.1.0-e29cdbe82692341ebb7ce6e2798294f9 base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a binary-0.7.3.0-0f543654a1ae447e0d4d0bbfc1bb704e bytestring-0.10.6.0-0909f8f31271f3d75749190bf2ee35db containers-0.5.6.2-2114032c163425cc264e6e1169dc2f6d deepseq-1.4.1.1-c1376f846fa170f2cc2cb2e57b203339 directory-1.2.2.0-b4959b472d9eee380c6b32291ade29e0 filepath-1.4.0.0-40d643aa87258c186441a1f8f3e13ca6 pretty-1.1.2.0-0d4e1eca3b0cfcebe20b9405f7bdaca9 process-1.2.3.0-3b1e9bca6ac38225806ff7bbf3f845b1 time-1.5.0.1-e17a9220d438435579d2914e90774246 unix-2.7.1.0-e5915eb989e568b732bc7286b0d0817f haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/Cabal-1.22.2.0/Cabal.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/Cabal-1.22.2.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: binary version: 0.7.3.0 id: binary-0.7.3.0-0f543654a1ae447e0d4d0bbfc1bb704e key: binar_EKE3c9Lmxb3DQpU0fPtru6 license: BSD3 maintainer: Lennart Kolmodin, Don Stewart stability: provisional homepage: https://github.com/kolmodin/binary synopsis: Binary serialisation for Haskell values using lazy ByteStrings description: Efficient, pure binary serialisation using lazy ByteStrings. Haskell values may be encoded to and from binary formats, written to disk as binary, or sent over the network. The format used can be automatically generated, or you can choose to implement a custom format if needed. Serialisation speeds of over 1 G\/sec have been observed, so this library should be suitable for high performance scenarios. category: Data, Parsing author: Lennart Kolmodin exposed: True exposed-modules: Data.Binary Data.Binary.Put Data.Binary.Get Data.Binary.Get.Internal Data.Binary.Builder Data.Binary.Builder.Internal hidden-modules: Data.Binary.Builder.Base Data.Binary.Class Data.Binary.Generic trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/binar_EKE3c9Lmxb3DQpU0fPtru6 library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/binar_EKE3c9Lmxb3DQpU0fPtru6 data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/binary-0.7.3.0 hs-libraries: HSbinary-0.7.3.0-EKE3c9Lmxb3DQpU0fPtru6 depends: array-0.5.1.0-e29cdbe82692341ebb7ce6e2798294f9 base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a bytestring-0.10.6.0-0909f8f31271f3d75749190bf2ee35db containers-0.5.6.2-2114032c163425cc264e6e1169dc2f6d haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/binary-0.7.3.0/binary.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/binary-0.7.3.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: template-haskell version: 2.10.0.0 id: template-haskell-2.10.0.0-e895139a0ffff267d412e3d0191ce93b key: templ_BVMCZyLwIlfGfcqqzyUAI8 license: BSD3 maintainer: libraries@haskell.org synopsis: Support library for Template Haskell description: This package provides modules containing facilities for manipulating Haskell source code using Template Haskell. . See for more information. category: Template Haskell exposed: True exposed-modules: Language.Haskell.TH Language.Haskell.TH.Lib Language.Haskell.TH.Ppr Language.Haskell.TH.PprLib Language.Haskell.TH.Quote Language.Haskell.TH.Syntax hidden-modules: Language.Haskell.TH.Lib.Map trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/templ_BVMCZyLwIlfGfcqqzyUAI8 library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/templ_BVMCZyLwIlfGfcqqzyUAI8 data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/template-haskell-2.10.0.0 hs-libraries: HStemplate-haskell-2.10.0.0-BVMCZyLwIlfGfcqqzyUAI8 depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a pretty-1.1.2.0-0d4e1eca3b0cfcebe20b9405f7bdaca9 haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/template-haskell-2.10.0.0/template-haskell.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/template-haskell-2.10.0.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: pretty version: 1.1.2.0 id: pretty-1.1.2.0-0d4e1eca3b0cfcebe20b9405f7bdaca9 key: prett_7jIfj8VCGFf1WS0tIQ1XSZ license: BSD3 maintainer: David Terei stability: Stable homepage: http://github.com/haskell/pretty synopsis: Pretty-printing library description: This package contains a pretty-printing library, a set of API's that provides a way to easily print out text in a consistent format of your choosing. This is useful for compilers and related tools. . This library was originally designed by John Hughes's and has since been heavily modified by Simon Peyton Jones. category: Text exposed: True exposed-modules: Text.PrettyPrint Text.PrettyPrint.HughesPJ Text.PrettyPrint.HughesPJClass trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/prett_7jIfj8VCGFf1WS0tIQ1XSZ library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/prett_7jIfj8VCGFf1WS0tIQ1XSZ data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/pretty-1.1.2.0 hs-libraries: HSpretty-1.1.2.0-7jIfj8VCGFf1WS0tIQ1XSZ depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a deepseq-1.4.1.1-c1376f846fa170f2cc2cb2e57b203339 ghc-prim-0.4.0.0-7c945cc0c41d3b7b70f3edd125671166 haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/pretty-1.1.2.0/pretty.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/pretty-1.1.2.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: hpc version: 0.6.0.2 id: hpc-0.6.0.2-ac9064885aa8cb08a93314222939ead4 key: hpc_CmUUQl5bURfBueJrdYfNs3 license: BSD3 maintainer: ghc-devs@haskell.org synopsis: Code Coverage Library for Haskell description: This package provides the code coverage library for Haskell. . See for more information. category: Control author: Andy Gill exposed: True exposed-modules: Trace.Hpc.Util Trace.Hpc.Mix Trace.Hpc.Tix Trace.Hpc.Reflect trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/hpc_CmUUQl5bURfBueJrdYfNs3 library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/hpc_CmUUQl5bURfBueJrdYfNs3 data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/hpc-0.6.0.2 hs-libraries: HShpc-0.6.0.2-CmUUQl5bURfBueJrdYfNs3 depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a containers-0.5.6.2-2114032c163425cc264e6e1169dc2f6d directory-1.2.2.0-b4959b472d9eee380c6b32291ade29e0 filepath-1.4.0.0-40d643aa87258c186441a1f8f3e13ca6 time-1.5.0.1-e17a9220d438435579d2914e90774246 haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/hpc-0.6.0.2/hpc.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/hpc-0.6.0.2 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: process version: 1.2.3.0 id: process-1.2.3.0-3b1e9bca6ac38225806ff7bbf3f845b1 key: proce_0hwN3CTKynhHQqQkChnSdH license: BSD3 maintainer: libraries@haskell.org synopsis: Process libraries description: This package contains libraries for dealing with system processes. category: System exposed: True exposed-modules: System.Cmd System.Process System.Process.Internals trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/proce_0hwN3CTKynhHQqQkChnSdH library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/proce_0hwN3CTKynhHQqQkChnSdH data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/process-1.2.3.0 hs-libraries: HSprocess-1.2.3.0-0hwN3CTKynhHQqQkChnSdH include-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/proce_0hwN3CTKynhHQqQkChnSdH/include includes: runProcess.h depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a deepseq-1.4.1.1-c1376f846fa170f2cc2cb2e57b203339 directory-1.2.2.0-b4959b472d9eee380c6b32291ade29e0 filepath-1.4.0.0-40d643aa87258c186441a1f8f3e13ca6 unix-2.7.1.0-e5915eb989e568b732bc7286b0d0817f haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/process-1.2.3.0/process.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/process-1.2.3.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: directory version: 1.2.2.0 id: directory-1.2.2.0-b4959b472d9eee380c6b32291ade29e0 key: direc_3TcTyYedch32o1zTH2MR00 license: BSD3 maintainer: libraries@haskell.org synopsis: Platform-agnostic library for filesystem operations description: This library provides a basic set of operations for manipulating files and directories in a portable way. category: System exposed: True exposed-modules: System.Directory trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/direc_3TcTyYedch32o1zTH2MR00 library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/direc_3TcTyYedch32o1zTH2MR00 data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/directory-1.2.2.0 hs-libraries: HSdirectory-1.2.2.0-3TcTyYedch32o1zTH2MR00 include-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/direc_3TcTyYedch32o1zTH2MR00/include includes: HsDirectory.h depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a filepath-1.4.0.0-40d643aa87258c186441a1f8f3e13ca6 time-1.5.0.1-e17a9220d438435579d2914e90774246 unix-2.7.1.0-e5915eb989e568b732bc7286b0d0817f haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/directory-1.2.2.0/directory.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/directory-1.2.2.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: unix version: 2.7.1.0 id: unix-2.7.1.0-e5915eb989e568b732bc7286b0d0817f key: unix_G4Yo1pNtYrk8nCq1cx8P9d license: BSD3 maintainer: libraries@haskell.org homepage: https://github.com/haskell/unix synopsis: POSIX functionality description: This package gives you access to the set of operating system services standardised by POSIX 1003.1b (or the IEEE Portable Operating System Interface for Computing Environments - IEEE Std. 1003.1). . The package is not supported under Windows (except under Cygwin). category: System exposed: True exposed-modules: System.Posix System.Posix.ByteString System.Posix.Error System.Posix.Resource System.Posix.Time System.Posix.Unistd System.Posix.User System.Posix.Signals System.Posix.Signals.Exts System.Posix.Semaphore System.Posix.SharedMem System.Posix.ByteString.FilePath System.Posix.Directory System.Posix.Directory.ByteString System.Posix.DynamicLinker.Module System.Posix.DynamicLinker.Module.ByteString System.Posix.DynamicLinker.Prim System.Posix.DynamicLinker.ByteString System.Posix.DynamicLinker System.Posix.Files System.Posix.Files.ByteString System.Posix.IO System.Posix.IO.ByteString System.Posix.Env System.Posix.Env.ByteString System.Posix.Fcntl System.Posix.Process System.Posix.Process.Internals System.Posix.Process.ByteString System.Posix.Temp System.Posix.Temp.ByteString System.Posix.Terminal System.Posix.Terminal.ByteString hidden-modules: System.Posix.Directory.Common System.Posix.DynamicLinker.Common System.Posix.Files.Common System.Posix.IO.Common System.Posix.Process.Common System.Posix.Terminal.Common trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/unix_G4Yo1pNtYrk8nCq1cx8P9d library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/unix_G4Yo1pNtYrk8nCq1cx8P9d data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/unix-2.7.1.0 hs-libraries: HSunix-2.7.1.0-G4Yo1pNtYrk8nCq1cx8P9d extra-libraries: rt util dl pthread include-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/unix_G4Yo1pNtYrk8nCq1cx8P9d/include includes: HsUnix.h execvpe.h depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a bytestring-0.10.6.0-0909f8f31271f3d75749190bf2ee35db time-1.5.0.1-e17a9220d438435579d2914e90774246 haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/unix-2.7.1.0/unix.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/unix-2.7.1.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: time version: 1.5.0.1 id: time-1.5.0.1-e17a9220d438435579d2914e90774246 key: time_Hh2clZW6in4HpYHx5bLtb7 license: BSD3 maintainer: stability: stable homepage: https://github.com/haskell/time synopsis: A time library description: A time library category: System author: Ashley Yakeley exposed: True exposed-modules: Data.Time.Calendar Data.Time.Calendar.MonthDay Data.Time.Calendar.OrdinalDate Data.Time.Calendar.WeekDate Data.Time.Calendar.Julian Data.Time.Calendar.Easter Data.Time.Clock Data.Time.Clock.POSIX Data.Time.Clock.TAI Data.Time.LocalTime Data.Time.Format Data.Time hidden-modules: Data.Time.Calendar.Private Data.Time.Calendar.Days Data.Time.Calendar.Gregorian Data.Time.Calendar.JulianYearDay Data.Time.Clock.Scale Data.Time.Clock.UTC Data.Time.Clock.CTimeval Data.Time.Clock.UTCDiff Data.Time.LocalTime.TimeZone Data.Time.LocalTime.TimeOfDay Data.Time.LocalTime.LocalTime Data.Time.Format.Parse Data.Time.Format.Locale trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/time_Hh2clZW6in4HpYHx5bLtb7 library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/time_Hh2clZW6in4HpYHx5bLtb7 data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/time-1.5.0.1 hs-libraries: HStime-1.5.0.1-Hh2clZW6in4HpYHx5bLtb7 include-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/time_Hh2clZW6in4HpYHx5bLtb7/include depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a deepseq-1.4.1.1-c1376f846fa170f2cc2cb2e57b203339 haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/time-1.5.0.1/time.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/time-1.5.0.1 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: containers version: 0.5.6.2 id: containers-0.5.6.2-2114032c163425cc264e6e1169dc2f6d key: conta_47ajk3tbda43DFWyeF3oHQ license: BSD3 maintainer: fox@ucw.cz synopsis: Assorted concrete container types description: This package contains efficient general-purpose implementations of various basic immutable container types. The declared cost of each operation is either worst-case or amortized, but remains valid even if structures are shared. category: Data Structures exposed: True exposed-modules: Data.IntMap Data.IntMap.Lazy Data.IntMap.Strict Data.IntSet Data.Map Data.Map.Lazy Data.Map.Strict Data.Set Data.Graph Data.Sequence Data.Tree hidden-modules: Data.IntMap.Base Data.IntSet.Base Data.Map.Base Data.Set.Base Data.Utils.BitUtil Data.Utils.StrictFold Data.Utils.StrictPair trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/conta_47ajk3tbda43DFWyeF3oHQ library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/conta_47ajk3tbda43DFWyeF3oHQ data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/containers-0.5.6.2 hs-libraries: HScontainers-0.5.6.2-47ajk3tbda43DFWyeF3oHQ depends: array-0.5.1.0-e29cdbe82692341ebb7ce6e2798294f9 base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a deepseq-1.4.1.1-c1376f846fa170f2cc2cb2e57b203339 ghc-prim-0.4.0.0-7c945cc0c41d3b7b70f3edd125671166 haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/containers-0.5.6.2/containers.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/containers-0.5.6.2 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: bytestring version: 0.10.6.0 id: bytestring-0.10.6.0-0909f8f31271f3d75749190bf2ee35db key: bytes_6vj5EoliHgNHISHCVCb069 license: BSD3 copyright: Copyright (c) Don Stewart 2005-2009, (c) Duncan Coutts 2006-2015, (c) David Roundy 2003-2005, (c) Jasper Van der Jeugt 2010, (c) Simon Meier 2010-2013. maintainer: Duncan Coutts homepage: https://github.com/haskell/bytestring synopsis: Fast, compact, strict and lazy byte strings with a list interface description: An efficient compact, immutable byte string type (both strict and lazy) suitable for binary or 8-bit character data. . The 'ByteString' type represents sequences of bytes or 8-bit characters. It is suitable for high performance use, both in terms of large data quantities, or high speed requirements. The 'ByteString' functions follow the same style as Haskell\'s ordinary lists, so it is easy to convert code from using 'String' to 'ByteString'. . Two 'ByteString' variants are provided: . * Strict 'ByteString's keep the string as a single large array. This makes them convenient for passing data between C and Haskell. . * Lazy 'ByteString's use a lazy list of strict chunks which makes it suitable for I\/O streaming tasks. . The @Char8@ modules provide a character-based view of the same underlying 'ByteString' types. This makes it convenient to handle mixed binary and 8-bit character content (which is common in many file formats and network protocols). . The 'Builder' module provides an efficient way to build up 'ByteString's in an ad-hoc way by repeated concatenation. This is ideal for fast serialisation or pretty printing. . There is also a 'ShortByteString' type which has a lower memory overhead and can can be converted to or from a 'ByteString', but supports very few other operations. It is suitable for keeping many short strings in memory. . 'ByteString's are not designed for Unicode. For Unicode strings you should use the 'Text' type from the @text@ package. . These modules are intended to be imported qualified, to avoid name clashes with "Prelude" functions, e.g. . > import qualified Data.ByteString as BS category: Data author: Don Stewart, Duncan Coutts exposed: True exposed-modules: Data.ByteString Data.ByteString.Char8 Data.ByteString.Unsafe Data.ByteString.Internal Data.ByteString.Lazy Data.ByteString.Lazy.Char8 Data.ByteString.Lazy.Internal Data.ByteString.Short Data.ByteString.Short.Internal Data.ByteString.Builder Data.ByteString.Builder.Extra Data.ByteString.Builder.Prim Data.ByteString.Builder.Internal Data.ByteString.Builder.Prim.Internal Data.ByteString.Lazy.Builder Data.ByteString.Lazy.Builder.Extras Data.ByteString.Lazy.Builder.ASCII hidden-modules: Data.ByteString.Builder.ASCII Data.ByteString.Builder.Prim.Binary Data.ByteString.Builder.Prim.ASCII Data.ByteString.Builder.Prim.Internal.Floating Data.ByteString.Builder.Prim.Internal.UncheckedShifts Data.ByteString.Builder.Prim.Internal.Base16 trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/bytes_6vj5EoliHgNHISHCVCb069 library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/bytes_6vj5EoliHgNHISHCVCb069 data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/bytestring-0.10.6.0 hs-libraries: HSbytestring-0.10.6.0-6vj5EoliHgNHISHCVCb069 include-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/bytes_6vj5EoliHgNHISHCVCb069/include includes: fpstring.h depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a deepseq-1.4.1.1-c1376f846fa170f2cc2cb2e57b203339 ghc-prim-0.4.0.0-7c945cc0c41d3b7b70f3edd125671166 integer-gmp-1.0.0.0-3c947e5fb6dca14804d9b2793c521b67 haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/bytestring-0.10.6.0/bytestring.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/bytestring-0.10.6.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: deepseq version: 1.4.1.1 id: deepseq-1.4.1.1-c1376f846fa170f2cc2cb2e57b203339 key: deeps_FpR4obOZALU1lutWnrBldi license: BSD3 maintainer: libraries@haskell.org synopsis: Deep evaluation of data structures description: This package provides methods for fully evaluating data structures (\"deep evaluation\"). Deep evaluation is often used for adding strictness to a program, e.g. in order to force pending exceptions, remove space leaks, or force lazy I/O to happen. It is also useful in parallel programs, to ensure pending work does not migrate to the wrong thread. . The primary use of this package is via the 'deepseq' function, a \"deep\" version of 'seq'. It is implemented on top of an 'NFData' typeclass (\"Normal Form Data\", data structures with no unevaluated components) which defines strategies for fully evaluating different data types. category: Control exposed: True exposed-modules: Control.DeepSeq trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/deeps_FpR4obOZALU1lutWnrBldi library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/deeps_FpR4obOZALU1lutWnrBldi data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/deepseq-1.4.1.1 hs-libraries: HSdeepseq-1.4.1.1-FpR4obOZALU1lutWnrBldi depends: array-0.5.1.0-e29cdbe82692341ebb7ce6e2798294f9 base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/deepseq-1.4.1.1/deepseq.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/deepseq-1.4.1.1 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: array version: 0.5.1.0 id: array-0.5.1.0-e29cdbe82692341ebb7ce6e2798294f9 key: array_FaHmcBFfuRM8kmZLEY8D5S license: BSD3 maintainer: libraries@haskell.org synopsis: Mutable and immutable arrays description: In addition to providing the "Data.Array" module , this package also defines the classes 'IArray' of immutable arrays and 'MArray' of arrays mutable within appropriate monads, as well as some instances of these classes. category: Data Structures exposed: True exposed-modules: Data.Array Data.Array.Base Data.Array.IArray Data.Array.IO Data.Array.IO.Safe Data.Array.IO.Internals Data.Array.MArray Data.Array.MArray.Safe Data.Array.ST Data.Array.ST.Safe Data.Array.Storable Data.Array.Storable.Safe Data.Array.Storable.Internals Data.Array.Unboxed Data.Array.Unsafe trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/array_FaHmcBFfuRM8kmZLEY8D5S library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/array_FaHmcBFfuRM8kmZLEY8D5S data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/array-0.5.1.0 hs-libraries: HSarray-0.5.1.0-FaHmcBFfuRM8kmZLEY8D5S depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/array-0.5.1.0/array.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/array-0.5.1.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: filepath version: 1.4.0.0 id: filepath-1.4.0.0-40d643aa87258c186441a1f8f3e13ca6 key: filep_5HhyRonfEZoDO205Wm9E4h license: BSD3 copyright: Neil Mitchell 2005-2015 maintainer: Neil Mitchell homepage: https://github.com/haskell/filepath#readme synopsis: Library for manipulating FilePaths in a cross platform way. description: This package provides functionality for manipulating @FilePath@ values, and is shipped with both and the . It provides three modules: . * "System.FilePath.Posix" manipulates POSIX\/Linux style @FilePath@ values (with @\/@ as the path separator). . * "System.FilePath.Windows" manipulates Windows style @FilePath@ values (with either @\\@ or @\/@ as the path separator, and deals with drives). . * "System.FilePath" is an alias for the module appropriate to your platform. . All three modules provide the same API, and the same documentation (calling out differences in the different variants). category: System author: Neil Mitchell exposed: True exposed-modules: System.FilePath System.FilePath.Posix System.FilePath.Windows trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/filep_5HhyRonfEZoDO205Wm9E4h library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/filep_5HhyRonfEZoDO205Wm9E4h data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/filepath-1.4.0.0 hs-libraries: HSfilepath-1.4.0.0-5HhyRonfEZoDO205Wm9E4h depends: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/filepath-1.4.0.0/filepath.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/filepath-1.4.0.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: base version: 4.8.0.0 id: base-4.8.0.0-1b689eb8d72c4d4cc88f445839c1f01a key: base_I5BErHzyOm07EBNpKBEeUv license: BSD3 maintainer: libraries@haskell.org synopsis: Basic libraries description: This package contains the "Prelude" and its support libraries, and a large collection of useful libraries ranging from data structures to parsing combinators and debugging utilities. category: Prelude exposed: True exposed-modules: Control.Applicative Control.Arrow Control.Category Control.Concurrent Control.Concurrent.Chan Control.Concurrent.MVar Control.Concurrent.QSem Control.Concurrent.QSemN Control.Exception Control.Exception.Base Control.Monad Control.Monad.Fix Control.Monad.Instances Control.Monad.ST Control.Monad.ST.Lazy Control.Monad.ST.Lazy.Safe Control.Monad.ST.Lazy.Unsafe Control.Monad.ST.Safe Control.Monad.ST.Strict Control.Monad.ST.Unsafe Control.Monad.Zip Data.Bifunctor Data.Bits Data.Bool Data.Char Data.Coerce Data.Complex Data.Data Data.Dynamic Data.Either Data.Eq Data.Fixed Data.Foldable Data.Function Data.Functor Data.Functor.Identity Data.IORef Data.Int Data.Ix Data.List Data.Maybe Data.Monoid Data.Ord Data.Proxy Data.Ratio Data.STRef Data.STRef.Lazy Data.STRef.Strict Data.String Data.Traversable Data.Tuple Data.Type.Bool Data.Type.Coercion Data.Type.Equality Data.Typeable Data.Typeable.Internal Data.Unique Data.Version Data.Void Data.Word Debug.Trace Foreign Foreign.C Foreign.C.Error Foreign.C.String Foreign.C.Types Foreign.Concurrent Foreign.ForeignPtr Foreign.ForeignPtr.Safe Foreign.ForeignPtr.Unsafe Foreign.Marshal Foreign.Marshal.Alloc Foreign.Marshal.Array Foreign.Marshal.Error Foreign.Marshal.Pool Foreign.Marshal.Safe Foreign.Marshal.Unsafe Foreign.Marshal.Utils Foreign.Ptr Foreign.Safe Foreign.StablePtr Foreign.Storable GHC.Arr GHC.Base GHC.Char GHC.Conc GHC.Conc.IO GHC.Conc.Signal GHC.Conc.Sync GHC.ConsoleHandler GHC.Constants GHC.Desugar GHC.Enum GHC.Environment GHC.Err GHC.Exception GHC.Exts GHC.Fingerprint GHC.Fingerprint.Type GHC.Float GHC.Float.ConversionUtils GHC.Float.RealFracMethods GHC.Foreign GHC.ForeignPtr GHC.GHCi GHC.Generics GHC.IO GHC.IO.Buffer GHC.IO.BufferedIO GHC.IO.Device GHC.IO.Encoding GHC.IO.Encoding.CodePage GHC.IO.Encoding.Failure GHC.IO.Encoding.Iconv GHC.IO.Encoding.Latin1 GHC.IO.Encoding.Types GHC.IO.Encoding.UTF16 GHC.IO.Encoding.UTF32 GHC.IO.Encoding.UTF8 GHC.IO.Exception GHC.IO.FD GHC.IO.Handle GHC.IO.Handle.FD GHC.IO.Handle.Internals GHC.IO.Handle.Text GHC.IO.Handle.Types GHC.IO.IOMode GHC.IOArray GHC.IORef GHC.IP GHC.Int GHC.List GHC.MVar GHC.Natural GHC.Num GHC.OldList GHC.PArr GHC.Pack GHC.Profiling GHC.Ptr GHC.Read GHC.Real GHC.RTS.Flags GHC.ST GHC.StaticPtr GHC.STRef GHC.Show GHC.Stable GHC.Stack GHC.Stats GHC.Storable GHC.TopHandler GHC.TypeLits GHC.Unicode GHC.Weak GHC.Word Numeric Numeric.Natural Prelude System.CPUTime System.Console.GetOpt System.Environment System.Exit System.IO System.IO.Error System.IO.Unsafe System.Info System.Mem System.Mem.StableName System.Mem.Weak System.Posix.Internals System.Posix.Types System.Timeout Text.ParserCombinators.ReadP Text.ParserCombinators.ReadPrec Text.Printf Text.Read Text.Read.Lex Text.Show Text.Show.Functions Unsafe.Coerce GHC.Event hidden-modules: Control.Monad.ST.Imp Control.Monad.ST.Lazy.Imp Data.OldList Foreign.ForeignPtr.Imp System.Environment.ExecutablePath GHC.Event.Arr GHC.Event.Array GHC.Event.Clock GHC.Event.Control GHC.Event.EPoll GHC.Event.IntTable GHC.Event.Internal GHC.Event.KQueue GHC.Event.Manager GHC.Event.PSQ GHC.Event.Poll GHC.Event.Thread GHC.Event.TimerManager GHC.Event.Unique trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/base_I5BErHzyOm07EBNpKBEeUv library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/base_I5BErHzyOm07EBNpKBEeUv data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/base-4.8.0.0 hs-libraries: HSbase-4.8.0.0-I5BErHzyOm07EBNpKBEeUv include-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/base_I5BErHzyOm07EBNpKBEeUv/include includes: HsBase.h depends: builtin_rts ghc-prim-0.4.0.0-7c945cc0c41d3b7b70f3edd125671166 integer-gmp-1.0.0.0-3c947e5fb6dca14804d9b2793c521b67 haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/base-4.8.0.0/base.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/base-4.8.0.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: integer-gmp version: 1.0.0.0 id: integer-gmp-1.0.0.0-3c947e5fb6dca14804d9b2793c521b67 key: integ_2aU3IZNMF9a7mQ0OzsZ0dS license: BSD3 maintainer: hvr@gnu.org synopsis: Integer library based on GMP category: Numeric, Algebra author: Herbert Valerio Riedel exposed: True exposed-modules: GHC.Integer GHC.Integer.Logarithms GHC.Integer.Logarithms.Internals GHC.Integer.GMP.Internals hidden-modules: GHC.Integer.Type trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/integ_2aU3IZNMF9a7mQ0OzsZ0dS library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/integ_2aU3IZNMF9a7mQ0OzsZ0dS data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/integer-gmp-1.0.0.0 hs-libraries: HSinteger-gmp-1.0.0.0-2aU3IZNMF9a7mQ0OzsZ0dS extra-libraries: gmp include-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/integ_2aU3IZNMF9a7mQ0OzsZ0dS/include depends: ghc-prim-0.4.0.0-7c945cc0c41d3b7b70f3edd125671166 haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/integer-gmp-1.0.0.0/integer-gmp.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/integer-gmp-1.0.0.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: ghc-prim version: 0.4.0.0 id: ghc-prim-0.4.0.0-7c945cc0c41d3b7b70f3edd125671166 key: ghcpr_8TmvWUcS1U1IKHT0levwg3 license: BSD3 maintainer: libraries@haskell.org synopsis: GHC primitives description: GHC primitives. category: GHC exposed: True exposed-modules: GHC.CString GHC.Classes GHC.Debug GHC.IntWord64 GHC.Magic GHC.PrimopWrappers GHC.Tuple GHC.Types GHC.Prim trusted: False import-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/ghcpr_8TmvWUcS1U1IKHT0levwg3 library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/ghcpr_8TmvWUcS1U1IKHT0levwg3 data-dir: /opt/ghc/7.10.1/share/x86_64-linux-ghc-7.10.1/ghc-prim-0.4.0.0 hs-libraries: HSghc-prim-0.4.0.0-8TmvWUcS1U1IKHT0levwg3 depends: builtin_rts haddock-interfaces: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/ghc-prim-0.4.0.0/ghc-prim.haddock haddock-html: /opt/ghc/7.10.1/share/doc/ghc/html/libraries/ghc-prim-0.4.0.0 pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" --- name: rts version: 1.0 id: builtin_rts key: rts license: BSD3 maintainer: glasgow-haskell-users@haskell.org exposed: True trusted: False library-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/rts hs-libraries: HSrts Cffi extra-libraries: m rt dl include-dirs: /opt/ghc/7.10.1/lib/ghc-7.10.1/include includes: Stg.h ld-options: "-Wl,-u,ghczmprim_GHCziTypes_Izh_static_info" "-Wl,-u,ghczmprim_GHCziTypes_Czh_static_info" "-Wl,-u,ghczmprim_GHCziTypes_Fzh_static_info" "-Wl,-u,ghczmprim_GHCziTypes_Dzh_static_info" "-Wl,-u,base_GHCziPtr_Ptr_static_info" "-Wl,-u,ghczmprim_GHCziTypes_Wzh_static_info" "-Wl,-u,base_GHCziInt_I8zh_static_info" "-Wl,-u,base_GHCziInt_I16zh_static_info" "-Wl,-u,base_GHCziInt_I32zh_static_info" "-Wl,-u,base_GHCziInt_I64zh_static_info" "-Wl,-u,base_GHCziWord_W8zh_static_info" "-Wl,-u,base_GHCziWord_W16zh_static_info" "-Wl,-u,base_GHCziWord_W32zh_static_info" "-Wl,-u,base_GHCziWord_W64zh_static_info" "-Wl,-u,base_GHCziStable_StablePtr_static_info" "-Wl,-u,ghczmprim_GHCziTypes_Izh_con_info" "-Wl,-u,ghczmprim_GHCziTypes_Czh_con_info" "-Wl,-u,ghczmprim_GHCziTypes_Fzh_con_info" "-Wl,-u,ghczmprim_GHCziTypes_Dzh_con_info" "-Wl,-u,base_GHCziPtr_Ptr_con_info" "-Wl,-u,base_GHCziPtr_FunPtr_con_info" "-Wl,-u,base_GHCziStable_StablePtr_con_info" "-Wl,-u,ghczmprim_GHCziTypes_False_closure" "-Wl,-u,ghczmprim_GHCziTypes_True_closure" "-Wl,-u,base_GHCziPack_unpackCString_closure" "-Wl,-u,base_GHCziIOziException_stackOverflow_closure" "-Wl,-u,base_GHCziIOziException_heapOverflow_closure" "-Wl,-u,base_ControlziExceptionziBase_nonTermination_closure" "-Wl,-u,base_GHCziIOziException_blockedIndefinitelyOnMVar_closure" "-Wl,-u,base_GHCziIOziException_blockedIndefinitelyOnSTM_closure" "-Wl,-u,base_GHCziIOziException_allocationLimitExceeded_closure" "-Wl,-u,base_ControlziExceptionziBase_nestedAtomically_closure" "-Wl,-u,base_GHCziEventziThread_blockedOnBadFD_closure" "-Wl,-u,base_GHCziWeak_runFinalizzerBatch_closure" "-Wl,-u,base_GHCziTopHandler_flushStdHandles_closure" "-Wl,-u,base_GHCziTopHandler_runIO_closure" "-Wl,-u,base_GHCziTopHandler_runNonIO_closure" "-Wl,-u,base_GHCziConcziIO_ensureIOManagerIsRunning_closure" "-Wl,-u,base_GHCziConcziIO_ioManagerCapabilitiesChanged_closure" "-Wl,-u,base_GHCziConcziSync_runSparks_closure" "-Wl,-u,base_GHCziConcziSignal_runHandlersPtr_closure" pkgroot: "/opt/ghc/7.10.1/lib/ghc-7.10.1" stack-1.1.2/stack.yaml0000644000000000000000000000056512717707441013017 0ustar0000000000000000resolver: lts-5.17 # docker: # enable: true # repo: fpco/stack-full # image: # containers: # - base: "fpco/stack-base" # see ./etc/docker/stack-base/Dockerfile # name: "fpco/stack-test" nix: # --nix on the command-line to enable. enable: false packages: - zlib extra-deps: - hpack-0.14.0 - path-io-1.1.0 - th-lift-instances-0.1.6 - aeson-0.11.2.0