{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}

module Stack.Init
    ( initProject
    , InitOpts (..)
    ) where

import           Stack.Prelude
import qualified Data.Aeson.KeyMap               as KeyMap
import qualified Data.ByteString.Builder         as B
import qualified Data.ByteString.Char8           as BC
import qualified Data.Foldable                   as F
import qualified Data.IntMap                     as IntMap
import           Data.List.Extra                 (groupSortOn)
import qualified Data.List.NonEmpty              as NonEmpty
import qualified Data.Map.Strict                 as Map
import qualified Data.Set                        as Set
import qualified Data.Text                       as T
import qualified Data.Text.Normalize             as T (normalize , NormalizationMode(NFC))
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           Path
import           Path.Extra                      (toFilePathNoTrailingSep)
import           Path.Find                       (findFiles)
import           Path.IO                         hiding (findFiles)
import qualified Paths_stack                     as Meta
import qualified RIO.FilePath                    as FP
import           RIO.List                        ((\\), intercalate, intersperse,
                                                  isSuffixOf, isPrefixOf)
import           RIO.List.Partial                (minimumBy)
import           Stack.BuildPlan
import           Stack.Config                    (getSnapshots,
                                                  makeConcreteResolver)
import           Stack.Constants
import           Stack.SourceMap
import           Stack.Types.Config
import           Stack.Types.Resolver
import           Stack.Types.Version

-- | Generate stack.yaml

initProject
    :: (HasConfig env, HasGHCVariant env)
    => Path Abs Dir
    -> InitOpts
    -> Maybe AbstractResolver
    -> RIO env ()
initProject :: forall env.
(HasConfig env, HasGHCVariant env) =>
Path Abs Dir -> InitOpts -> Maybe AbstractResolver -> RIO env ()
initProject Path Abs Dir
currDir InitOpts
initOpts Maybe AbstractResolver
mresolver = do
    let dest :: Path Abs File
dest = Path Abs Dir
currDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
stackDotYaml

    FilePath
reldest <- forall b t. Path b t -> FilePath
toFilePath forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall path (m :: * -> *).
(AnyPath path, MonadIO m) =>
path -> m (RelPath path)
makeRelativeToCurrentDir Path Abs File
dest

    Bool
exists <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
dest
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (InitOpts -> Bool
forceOverwrite InitOpts
initOpts) Bool -> Bool -> Bool
&& Bool
exists) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a.
(MonadIO m, ?callStack::CallStack) =>
FilePath -> m a
throwString
            (FilePath
"Error: Stack configuration file " forall a. Semigroup a => a -> a -> a
<> FilePath
reldest forall a. Semigroup a => a -> a -> a
<>
             FilePath
" exists, use '--force' to overwrite it.")

    [Path Abs Dir]
dirs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *). MonadIO m => FilePath -> m (Path Abs Dir)
resolveDir' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) (InitOpts -> [Text]
searchDirs InitOpts
initOpts)
    let find :: Path Abs Dir -> RIO env (Set (Path Abs Dir))
find  = forall env.
HasConfig env =>
Bool -> Path Abs Dir -> RIO env (Set (Path Abs Dir))
findCabalDirs (InitOpts -> Bool
includeSubDirs InitOpts
initOpts)
        dirs' :: [Path Abs Dir]
dirs' = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Abs Dir]
dirs then [Path Abs Dir
currDir] else [Path Abs Dir]
dirs
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"Looking for .cabal or package.yaml files to use to init the project."
    [Path Abs Dir]
cabaldirs <- forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Path Abs Dir -> RIO env (Set (Path Abs Dir))
find [Path Abs Dir]
dirs'
    (Map PackageName (Path Abs File, GenericPackageDescription)
bundle, [Path Abs File]
dupPkgs)  <- forall env.
(HasConfig env, HasGHCVariant env) =>
[Path Abs Dir]
-> Maybe FilePath
-> RIO
     env
     (Map PackageName (Path Abs File, GenericPackageDescription),
      [Path Abs File])
cabalPackagesCheck [Path Abs Dir]
cabaldirs forall a. Maybe a
Nothing
    let makeRelDir :: Path Abs Dir -> FilePath
makeRelDir Path Abs Dir
dir =
            case forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path Abs Dir
currDir Path Abs Dir
dir of
                Maybe (Path Rel Dir)
Nothing
                    | Path Abs Dir
currDir forall a. Eq a => a -> a -> Bool
== Path Abs Dir
dir -> FilePath
"."
                    | Bool
otherwise -> forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False forall a b. (a -> b) -> a -> b
$ forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
dir
                Just Path Rel Dir
rel -> forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Rel Dir
rel
        fpToPkgDir :: Path Abs File -> ResolvedPath Dir
fpToPkgDir Path Abs File
fp =
            let absDir :: Path Abs Dir
absDir = forall b t. Path b t -> Path b Dir
parent Path Abs File
fp
            in forall t. RelFilePath -> Path Abs t -> ResolvedPath t
ResolvedPath (Text -> RelFilePath
RelFilePath forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> FilePath
makeRelDir Path Abs Dir
absDir) Path Abs Dir
absDir
        pkgDirs :: Map PackageName (ResolvedPath Dir)
pkgDirs = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (Path Abs File -> ResolvedPath Dir
fpToPkgDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Map PackageName (Path Abs File, GenericPackageDescription)
bundle
    (RawSnapshotLocation
snapshotLoc, Map PackageName (Map FlagName Bool)
flags, Map PackageName Version
extraDeps, Map PackageName (ResolvedPath Dir)
rbundle) <- forall env.
(HasConfig env, HasGHCVariant env) =>
InitOpts
-> Maybe AbstractResolver
-> Map PackageName (ResolvedPath Dir)
-> RIO
     env
     (RawSnapshotLocation, Map PackageName (Map FlagName Bool),
      Map PackageName Version, Map PackageName (ResolvedPath Dir))
getDefaultResolver InitOpts
initOpts Maybe AbstractResolver
mresolver Map PackageName (ResolvedPath Dir)
pkgDirs

    let ignored :: Map PackageName (Path Abs File, GenericPackageDescription)
ignored = forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.difference Map PackageName (Path Abs File, GenericPackageDescription)
bundle Map PackageName (ResolvedPath Dir)
rbundle
        dupPkgMsg :: FilePath
dupPkgMsg
            | [Path Abs File]
dupPkgs forall a. Eq a => a -> a -> Bool
/= [] =
                FilePath
"Warning (added by new or init): Some packages were found to " forall a. Semigroup a => a -> a -> a
<>
                FilePath
"have names conflicting with others and have been commented " forall a. Semigroup a => a -> a -> a
<>
                FilePath
"out in the packages section.\n"
            | Bool
otherwise = FilePath
""

        missingPkgMsg :: FilePath
missingPkgMsg
            | forall k a. Map k a -> Int
Map.size Map PackageName (Path Abs File, GenericPackageDescription)
ignored forall a. Ord a => a -> a -> Bool
> Int
0 =
                FilePath
"Warning (added by new or init): Some packages were found to " forall a. Semigroup a => a -> a -> a
<>
                FilePath
"be incompatible with the resolver and have been left commented " forall a. Semigroup a => a -> a -> a
<>
                FilePath
"out in the packages section.\n"
            | Bool
otherwise = FilePath
""

        extraDepMsg :: FilePath
extraDepMsg
            | forall k a. Map k a -> Int
Map.size Map PackageName Version
extraDeps forall a. Ord a => a -> a -> Bool
> Int
0 =
                FilePath
"Warning (added by new or init): Specified resolver could not " forall a. Semigroup a => a -> a -> a
<>
                FilePath
"satisfy all dependencies. Some external packages have been " forall a. Semigroup a => a -> a -> a
<>
                FilePath
"added as dependencies.\n"
            | Bool
otherwise = FilePath
""
        makeUserMsg :: t FilePath -> FilePath
makeUserMsg t FilePath
msgs =
            let msg :: FilePath
msg = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat t FilePath
msgs
            in if FilePath
msg forall a. Eq a => a -> a -> Bool
/= FilePath
"" then
                  FilePath
msg forall a. Semigroup a => a -> a -> a
<> FilePath
"You can omit this message by removing it from " forall a. Semigroup a => a -> a -> a
<>
                         FilePath
"stack.yaml\n"
                 else FilePath
""

        userMsg :: FilePath
userMsg = forall {t :: * -> *}. Foldable t => t FilePath -> FilePath
makeUserMsg [FilePath
dupPkgMsg, FilePath
missingPkgMsg, FilePath
extraDepMsg]

        gpdByDir :: Map (Path Abs Dir) GenericPackageDescription
gpdByDir = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (forall b t. Path b t -> Path b Dir
parent Path Abs File
fp, GenericPackageDescription
gpd) | (Path Abs File
fp, GenericPackageDescription
gpd) <- forall k a. Map k a -> [a]
Map.elems Map PackageName (Path Abs File, GenericPackageDescription)
bundle]
        gpds :: [GenericPackageDescription]
gpds = forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$
          forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Map (Path Abs Dir) GenericPackageDescription
gpdByDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. ResolvedPath t -> Path Abs t
resolvedAbsolute) Map PackageName (ResolvedPath Dir)
rbundle

    [PackageLocation]
deps <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (forall k a. Map k a -> [(k, a)]
Map.toList Map PackageName Version
extraDeps) forall a b. (a -> b) -> a -> b
$ \(PackageName
n, Version
v) ->
      PackageLocationImmutable -> PackageLocation
PLImmutable forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompletePackageLocation -> PackageLocationImmutable
cplComplete forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
RawPackageLocationImmutable -> RIO env CompletePackageLocation
completePackageLocation (PackageIdentifierRevision
-> Maybe TreeKey -> RawPackageLocationImmutable
RPLIHackage (PackageName
-> Version -> CabalFileInfo -> PackageIdentifierRevision
PackageIdentifierRevision PackageName
n Version
v CabalFileInfo
CFILatest) forall a. Maybe a
Nothing)

    let p :: Project
p = Project
            { projectUserMsg :: Maybe FilePath
projectUserMsg = if FilePath
userMsg forall a. Eq a => a -> a -> Bool
== FilePath
"" then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just FilePath
userMsg
            , projectPackages :: [RelFilePath]
projectPackages = forall t. ResolvedPath t -> RelFilePath
resolvedRelative forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Map k a -> [a]
Map.elems Map PackageName (ResolvedPath Dir)
rbundle
            , projectDependencies :: [RawPackageLocation]
projectDependencies = forall a b. (a -> b) -> [a] -> [b]
map PackageLocation -> RawPackageLocation
toRawPL [PackageLocation]
deps
            , projectFlags :: Map PackageName (Map FlagName Bool)
projectFlags = [GenericPackageDescription]
-> Map PackageName (Map FlagName Bool)
-> Map PackageName (Map FlagName Bool)
removeSrcPkgDefaultFlags [GenericPackageDescription]
gpds Map PackageName (Map FlagName Bool)
flags
            , projectResolver :: RawSnapshotLocation
projectResolver = RawSnapshotLocation
snapshotLoc
            , projectCompiler :: Maybe WantedCompiler
projectCompiler = forall a. Maybe a
Nothing
            , projectExtraPackageDBs :: [FilePath]
projectExtraPackageDBs = []
            , projectCurator :: Maybe Curator
projectCurator = forall a. Maybe a
Nothing
            , projectDropPackages :: Set PackageName
projectDropPackages = forall a. Monoid a => a
mempty
            }

        makeRel :: Path Abs File -> RIO env FilePath
makeRel = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b t. Path b t -> FilePath
toFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall path (m :: * -> *).
(AnyPath path, MonadIO m) =>
path -> m (RelPath path)
makeRelativeToCurrentDir

        indent :: Text -> Text
indent Text
t = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
"    " forall a. Semigroup a => a -> a -> a
<>) (Text -> [Text]
T.lines Text
t)

    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Initialising configuration using resolver: " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawSnapshotLocation
snapshotLoc
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Total number of user packages considered: "
               forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display (forall k a. Map k a -> Int
Map.size Map PackageName (Path Abs File, GenericPackageDescription)
bundle forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Path Abs File]
dupPkgs)

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Path Abs File]
dupPkgs forall a. Eq a => a -> a -> Bool
/= []) forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Warning! Ignoring "
                   forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Path Abs File]
dupPkgs)
                   forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" duplicate packages:"
        [FilePath]
rels <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Path Abs File -> RIO env FilePath
makeRel [Path Abs File]
dupPkgs
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Utf8Builder
display forall a b. (a -> b) -> a -> b
$ Text -> Text
indent forall a b. (a -> b) -> a -> b
$ [FilePath] -> Text
showItems [FilePath]
rels

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall k a. Map k a -> Int
Map.size Map PackageName (Path Abs File, GenericPackageDescription)
ignored forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Warning! Ignoring "
                   forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow (forall k a. Map k a -> Int
Map.size Map PackageName (Path Abs File, GenericPackageDescription)
ignored)
                   forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" packages due to dependency conflicts:"
        [FilePath]
rels <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Path Abs File -> RIO env FilePath
makeRel (forall k a. Map k a -> [a]
Map.elems (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst Map PackageName (Path Abs File, GenericPackageDescription)
ignored))
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Utf8Builder
display forall a b. (a -> b) -> a -> b
$ Text -> Text
indent forall a b. (a -> b) -> a -> b
$ [FilePath] -> Text
showItems [FilePath]
rels

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall k a. Map k a -> Int
Map.size Map PackageName Version
extraDeps forall a. Ord a => a -> a -> Bool
> Int
0) forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Warning! " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow (forall k a. Map k a -> Int
Map.size Map PackageName Version
extraDeps)
                   forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" external dependencies were added."
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$
        (if Bool
exists then Utf8Builder
"Overwriting existing configuration file: "
         else Utf8Builder
"Writing configuration to file: ")
        forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => FilePath -> a
fromString FilePath
reldest
    forall (m :: * -> *) absrel.
MonadIO m =>
Path absrel File -> Builder -> m ()
writeBinaryFileAtomic Path Abs File
dest
           forall a b. (a -> b) -> a -> b
$ Project -> [FilePath] -> [FilePath] -> Builder
renderStackYaml Project
p
               (forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Path Abs Dir -> FilePath
makeRelDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> Path b Dir
parent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Map PackageName (Path Abs File, GenericPackageDescription)
ignored)
               (forall a b. (a -> b) -> [a] -> [b]
map (Path Abs Dir -> FilePath
makeRelDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> Path b Dir
parent) [Path Abs File]
dupPkgs)
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"All done."

-- | Render a stack.yaml file with comments, see:

-- https://github.com/commercialhaskell/stack/issues/226

renderStackYaml :: Project -> [FilePath] -> [FilePath] -> B.Builder
renderStackYaml :: Project -> [FilePath] -> [FilePath] -> Builder
renderStackYaml Project
p [FilePath]
ignoredPackages [FilePath]
dupPackages =
    case forall a. ToJSON a => a -> Value
Yaml.toJSON Project
p of
        Yaml.Object Object
o -> Object -> Builder
renderObject Object
o
        Value
_ -> forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
B.byteString forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
Yaml.encode Project
p
  where
    renderObject :: Object -> Builder
renderObject Object
o =
           ByteString -> Builder
B.byteString ByteString
headerHelp
        forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
"\n\n"
        forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (Object -> (Key, ByteString) -> Builder
goComment Object
o) [(Key, ByteString)]
comments
        forall a. Semigroup a => a -> a -> a
<> forall {v}. ToJSON v => KeyMap v -> Builder
goOthers (Object
o forall v v'. KeyMap v -> KeyMap v' -> KeyMap v
`KeyMap.difference` forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList [(Key, ByteString)]
comments)
        forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
footerHelp
        forall a. Semigroup a => a -> a -> a
<> Builder
"\n"

    goComment :: Object -> (Key, ByteString) -> Builder
goComment Object
o (Key
name, ByteString
comment) =
        case (Value -> Builder
convert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
name Object
o) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {a} {a}. (Eq a, IsString a, IsString a) => a -> Maybe a
nonPresentValue Key
name of
            Maybe Builder
Nothing -> forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Key
name forall a. Eq a => a -> a -> Bool
== Key
"user-message") forall a. Monoid a => a
mempty
            Just Builder
v ->
                ByteString -> Builder
B.byteString ByteString
comment forall a. Semigroup a => a -> a -> a
<>
                ByteString -> Builder
B.byteString ByteString
"\n" forall a. Semigroup a => a -> a -> a
<>
                Builder
v forall a. Semigroup a => a -> a -> a
<>
                if Key
name forall a. Eq a => a -> a -> Bool
== Key
"packages" then Builder
commentedPackages else Builder
"" forall a. Semigroup a => a -> a -> a
<>
                ByteString -> Builder
B.byteString ByteString
"\n"
      where
        convert :: Value -> Builder
convert Value
v = ByteString -> Builder
B.byteString (forall a. ToJSON a => a -> ByteString
Yaml.encode forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Yaml.object [(Key
name, Value
v)])

        -- Some fields in stack.yaml are optional and may not be

        -- generated. For these, we provided commented out dummy

        -- values to go along with the comments.

        nonPresentValue :: a -> Maybe a
nonPresentValue a
"extra-deps" = forall a. a -> Maybe a
Just a
"# extra-deps: []\n"
        nonPresentValue a
"flags" = forall a. a -> Maybe a
Just a
"# flags: {}\n"
        nonPresentValue a
"extra-package-dbs" = forall a. a -> Maybe a
Just a
"# extra-package-dbs: []\n"
        nonPresentValue a
_ = forall a. Maybe a
Nothing

    commentLine :: FilePath -> FilePath
commentLine FilePath
l | forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
l = FilePath
"#"
                  | Bool
otherwise = FilePath
"# " forall a. [a] -> [a] -> [a]
++ FilePath
l
    commentHelp :: [FilePath] -> ByteString
commentHelp = FilePath -> ByteString
BC.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
commentLine
    commentedPackages :: Builder
commentedPackages =
        let ignoredComment :: ByteString
ignoredComment = [FilePath] -> ByteString
commentHelp
                [ FilePath
"The following packages have been ignored due to incompatibility with the"
                , FilePath
"resolver compiler, dependency conflicts with other packages"
                , FilePath
"or unsatisfied dependencies."
                ]
            dupComment :: ByteString
dupComment = [FilePath] -> ByteString
commentHelp
                [ FilePath
"The following packages have been ignored due to package name conflict "
                , FilePath
"with other packages."
                ]
        in ByteString -> [FilePath] -> Builder
commentPackages ByteString
ignoredComment [FilePath]
ignoredPackages
           forall a. Semigroup a => a -> a -> a
<> ByteString -> [FilePath] -> Builder
commentPackages ByteString
dupComment [FilePath]
dupPackages

    commentPackages :: ByteString -> [FilePath] -> Builder
commentPackages ByteString
comment [FilePath]
pkgs
        | [FilePath]
pkgs forall a. Eq a => a -> a -> Bool
/= [] =
               ByteString -> Builder
B.byteString ByteString
comment
            forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString ByteString
"\n"
            forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
B.byteString (FilePath -> ByteString
BC.pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
x -> FilePath
"#- " forall a. [a] -> [a] -> [a]
++ FilePath
x forall a. [a] -> [a] -> [a]
++ FilePath
"\n") [FilePath]
pkgs forall a. [a] -> [a] -> [a]
++ [FilePath
"\n"])
        | Bool
otherwise = Builder
""

    goOthers :: KeyMap v -> Builder
goOthers KeyMap v
o
        | forall v. KeyMap v -> Bool
KeyMap.null KeyMap v
o = forall a. Monoid a => a
mempty
        | Bool
otherwise = forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
False forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
B.byteString forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
Yaml.encode KeyMap v
o

    -- Per Section Help

    comments :: [(Key, ByteString)]
comments =
        [ (Key
"user-message"     , ByteString
userMsgHelp)
        , (Key
"resolver"         , ByteString
resolverHelp)
        , (Key
"packages"         , ByteString
packageHelp)
        , (Key
"extra-deps"       , ByteString
extraDepsHelp)
        , (Key
"flags"            , ByteString
"# Override default flag values for local packages and extra-deps")
        , (Key
"extra-package-dbs", ByteString
"# Extra package databases containing global packages")
        ]

    -- Help strings

    headerHelp :: ByteString
headerHelp = [FilePath] -> ByteString
commentHelp
        [ FilePath
"This file was automatically generated by 'stack init'"
        , FilePath
""
        , FilePath
"Some commonly used options have been documented as comments in this file."
        , FilePath
"For advanced use and comprehensive documentation of the format, please see:"
        , FilePath
"https://docs.haskellstack.org/en/stable/yaml_configuration/"
        ]

    resolverHelp :: ByteString
resolverHelp = [FilePath] -> ByteString
commentHelp
        [ FilePath
"Resolver to choose a 'specific' stackage snapshot or a compiler version."
        , FilePath
"A snapshot resolver dictates the compiler version and the set of packages"
        , FilePath
"to be used for project dependencies. For example:"
        , FilePath
""
        , FilePath
"resolver: lts-3.5"
        , FilePath
"resolver: nightly-2015-09-21"
        , FilePath
"resolver: ghc-7.10.2"
        , FilePath
""
        , FilePath
"The location of a snapshot can be provided as a file or url. Stack assumes"
        , FilePath
"a snapshot provided as a file might change, whereas a url resource does not."
        , FilePath
""
        , FilePath
"resolver: ./custom-snapshot.yaml"
        , FilePath
"resolver: https://example.com/snapshots/2018-01-01.yaml"
        ]

    userMsgHelp :: ByteString
userMsgHelp = [FilePath] -> ByteString
commentHelp
        [ FilePath
"A warning or info to be displayed to the user on config load." ]

    packageHelp :: ByteString
packageHelp = [FilePath] -> ByteString
commentHelp
        [ FilePath
"User packages to be built."
        , FilePath
"Various formats can be used as shown in the example below."
        , FilePath
""
        , FilePath
"packages:"
        , FilePath
"- some-directory"
        , FilePath
"- https://example.com/foo/bar/baz-0.0.2.tar.gz"
        , FilePath
"  subdirs:"
        , FilePath
"  - auto-update"
        , FilePath
"  - wai"
        ]

    extraDepsHelp :: ByteString
extraDepsHelp = [FilePath] -> ByteString
commentHelp
        [ FilePath
"Dependency packages to be pulled from upstream that are not in the resolver."
        , FilePath
"These entries can reference officially published versions as well as"
        , FilePath
"forks / in-progress versions pinned to a git hash. For example:"
        , FilePath
""
        , FilePath
"extra-deps:"
        , FilePath
"- acme-missiles-0.3"
        , FilePath
"- git: https://github.com/commercialhaskell/stack.git"
        , FilePath
"  commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a"
        , FilePath
""
        ]

    footerHelp :: ByteString
footerHelp =
        let major :: Version
major = Version -> Version
toMajorVersion forall a b. (a -> b) -> a -> b
$ Version -> Version
C.mkVersion' Version
Meta.version
        in [FilePath] -> ByteString
commentHelp
        [ FilePath
"Control whether we use the GHC we find on the path"
        , FilePath
"system-ghc: true"
        , FilePath
""
        , FilePath
"Require a specific version of stack, using version ranges"
        , FilePath
"require-stack-version: -any # Default"
        , FilePath
"require-stack-version: \""
          forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> FilePath
C.display (Version -> VersionRange
C.orLaterVersion Version
major) forall a. [a] -> [a] -> [a]
++ FilePath
"\""
        , FilePath
""
        , FilePath
"Override the architecture used by stack, especially useful on Windows"
        , FilePath
"arch: i386"
        , FilePath
"arch: x86_64"
        , FilePath
""
        , FilePath
"Extra directories used by stack for building"
        , FilePath
"extra-include-dirs: [/path/to/dir]"
        , FilePath
"extra-lib-dirs: [/path/to/dir]"
        , FilePath
""
        , FilePath
"Allow a newer minor version of GHC than the snapshot specifies"
        , FilePath
"compiler-check: newer-minor"
        ]

getSnapshots' :: HasConfig env => RIO env Snapshots
getSnapshots' :: forall env. HasConfig env => RIO env Snapshots
getSnapshots' = do
    forall env. HasConfig env => RIO env Snapshots
getSnapshots forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
e -> do
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logError forall a b. (a -> b) -> a -> b
$
            Utf8Builder
"Unable to download snapshot list, and therefore could " forall a. Semigroup a => a -> a -> a
<>
            Utf8Builder
"not generate a stack.yaml file automatically"
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logError forall a b. (a -> b) -> a -> b
$
            Utf8Builder
"This sometimes happens due to missing Certificate Authorities " forall a. Semigroup a => a -> a -> a
<>
            Utf8Builder
"on your system. For more information, see:"
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
""
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
"    https://github.com/commercialhaskell/stack/issues/234"
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
""
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
"You can try again, or create your stack.yaml file by hand. See:"
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
""
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
"    http://docs.haskellstack.org/en/stable/yaml_configuration/"
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logError Utf8Builder
""
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logError forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Exception was: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Utf8Builder
displayShow SomeException
e
        forall (m :: * -> *) a.
(MonadIO m, ?callStack::CallStack) =>
FilePath -> m a
throwString FilePath
""

-- | Get the default resolver value

getDefaultResolver
    :: (HasConfig env, HasGHCVariant env)
    => InitOpts
    -> Maybe AbstractResolver
    -> Map PackageName (ResolvedPath Dir)
    -- ^ Src package name: cabal dir

    -> RIO env
         ( RawSnapshotLocation
         , Map PackageName (Map FlagName Bool)
         , Map PackageName Version
         , Map PackageName (ResolvedPath Dir))
       -- ^ ( Resolver

       --   , Flags for src packages and extra deps

       --   , Extra dependencies

       --   , Src packages actually considered)

getDefaultResolver :: forall env.
(HasConfig env, HasGHCVariant env) =>
InitOpts
-> Maybe AbstractResolver
-> Map PackageName (ResolvedPath Dir)
-> RIO
     env
     (RawSnapshotLocation, Map PackageName (Map FlagName Bool),
      Map PackageName Version, Map PackageName (ResolvedPath Dir))
getDefaultResolver InitOpts
initOpts Maybe AbstractResolver
mresolver Map PackageName (ResolvedPath Dir)
pkgDirs = do
    (SnapshotCandidate env
candidate, RawSnapshotLocation
loc) <- case Maybe AbstractResolver
mresolver of
      Maybe AbstractResolver
Nothing -> RIO env (SnapshotCandidate env, RawSnapshotLocation)
selectSnapResolver
      Just AbstractResolver
ar -> do
        RawSnapshotLocation
sl <- forall env.
HasConfig env =>
AbstractResolver -> RIO env RawSnapshotLocation
makeConcreteResolver AbstractResolver
ar
        SnapshotCandidate env
c <- forall env.
HasConfig env =>
RawSnapshotLocation
-> PrintWarnings -> Bool -> RIO env (SnapshotCandidate env)
loadProjectSnapshotCandidate RawSnapshotLocation
sl PrintWarnings
NoPrintWarnings Bool
False
        forall (m :: * -> *) a. Monad m => a -> m a
return (SnapshotCandidate env
c, RawSnapshotLocation
sl)
    forall env.
(HasConfig env, HasGHCVariant env) =>
InitOpts
-> Map PackageName (ResolvedPath Dir)
-> SnapshotCandidate env
-> RawSnapshotLocation
-> RIO
     env
     (RawSnapshotLocation, Map PackageName (Map FlagName Bool),
      Map PackageName Version, Map PackageName (ResolvedPath Dir))
getWorkingResolverPlan InitOpts
initOpts Map PackageName (ResolvedPath Dir)
pkgDirs SnapshotCandidate env
candidate RawSnapshotLocation
loc
    where
        -- TODO support selecting best across regular and custom snapshots

        selectSnapResolver :: RIO env (SnapshotCandidate env, RawSnapshotLocation)
selectSnapResolver = do
            NonEmpty SnapName
snaps <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Snapshots -> NonEmpty SnapName
getRecommendedSnapshots forall env. HasConfig env => RIO env Snapshots
getSnapshots'
            (SnapshotCandidate env
c, RawSnapshotLocation
l, BuildPlanCheck
r) <- forall env.
(HasConfig env, HasGHCVariant env) =>
[ResolvedPath Dir]
-> NonEmpty SnapName
-> RIO
     env (SnapshotCandidate env, RawSnapshotLocation, BuildPlanCheck)
selectBestSnapshot (forall k a. Map k a -> [a]
Map.elems Map PackageName (ResolvedPath Dir)
pkgDirs) NonEmpty SnapName
snaps
            case BuildPlanCheck
r of
                BuildPlanCheckFail {} | Bool -> Bool
not (InitOpts -> Bool
omitPackages InitOpts
initOpts)
                        -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (NonEmpty SnapName -> ConfigException
NoMatchingSnapshot NonEmpty SnapName
snaps)
                BuildPlanCheck
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (SnapshotCandidate env
c, RawSnapshotLocation
l)

getWorkingResolverPlan
    :: (HasConfig env, HasGHCVariant env)
    => InitOpts
    -> Map PackageName (ResolvedPath Dir)
    -- ^ Src packages: cabal dir

    -> SnapshotCandidate env
    -> RawSnapshotLocation
    -> RIO env
         ( RawSnapshotLocation
         , Map PackageName (Map FlagName Bool)
         , Map PackageName Version
         , Map PackageName (ResolvedPath Dir))
       -- ^ ( SnapshotDef

       --   , Flags for src packages and extra deps

       --   , Extra dependencies

       --   , Src packages actually considered)

getWorkingResolverPlan :: forall env.
(HasConfig env, HasGHCVariant env) =>
InitOpts
-> Map PackageName (ResolvedPath Dir)
-> SnapshotCandidate env
-> RawSnapshotLocation
-> RIO
     env
     (RawSnapshotLocation, Map PackageName (Map FlagName Bool),
      Map PackageName Version, Map PackageName (ResolvedPath Dir))
getWorkingResolverPlan InitOpts
initOpts Map PackageName (ResolvedPath Dir)
pkgDirs0 SnapshotCandidate env
snapCandidate RawSnapshotLocation
snapLoc = do
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ Utf8Builder
"Selected resolver: " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawSnapshotLocation
snapLoc
    Map PackageName (ResolvedPath Dir)
-> RIO
     env
     (RawSnapshotLocation, Map PackageName (Map FlagName Bool),
      Map PackageName Version, Map PackageName (ResolvedPath Dir))
go Map PackageName (ResolvedPath Dir)
pkgDirs0
    where
        go :: Map PackageName (ResolvedPath Dir)
-> RIO
     env
     (RawSnapshotLocation, Map PackageName (Map FlagName Bool),
      Map PackageName Version, Map PackageName (ResolvedPath Dir))
go Map PackageName (ResolvedPath Dir)
pkgDirs = do
            Either
  [PackageName]
  (Map PackageName (Map FlagName Bool), Map PackageName Version)
eres <- forall env.
(HasConfig env, HasGHCVariant env) =>
InitOpts
-> RawSnapshotLocation
-> SnapshotCandidate env
-> [ResolvedPath Dir]
-> RIO
     env
     (Either
        [PackageName]
        (Map PackageName (Map FlagName Bool), Map PackageName Version))
checkBundleResolver InitOpts
initOpts RawSnapshotLocation
snapLoc SnapshotCandidate env
snapCandidate (forall k a. Map k a -> [a]
Map.elems Map PackageName (ResolvedPath Dir)
pkgDirs)
            -- if some packages failed try again using the rest

            case Either
  [PackageName]
  (Map PackageName (Map FlagName Bool), Map PackageName Version)
eres of
                Right (Map PackageName (Map FlagName Bool)
f, Map PackageName Version
edeps)-> forall (m :: * -> *) a. Monad m => a -> m a
return (RawSnapshotLocation
snapLoc, Map PackageName (Map FlagName Bool)
f, Map PackageName Version
edeps, Map PackageName (ResolvedPath Dir)
pkgDirs)
                Left [PackageName]
ignored
                    | forall k a. Map k a -> Bool
Map.null Map PackageName (ResolvedPath Dir)
available -> do
                        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"*** Could not find a working plan for any of " forall a. Semigroup a => a -> a -> a
<>
                                Utf8Builder
"the user packages.\nProceeding to create a " forall a. Semigroup a => a -> a -> a
<>
                                Utf8Builder
"config anyway."
                        forall (m :: * -> *) a. Monad m => a -> m a
return (RawSnapshotLocation
snapLoc, forall k a. Map k a
Map.empty, forall k a. Map k a
Map.empty, forall k a. Map k a
Map.empty)
                    | Bool
otherwise -> do
                        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall k a. Map k a -> Int
Map.size Map PackageName (ResolvedPath Dir)
available forall a. Eq a => a -> a -> Bool
== forall k a. Map k a -> Int
Map.size Map PackageName (ResolvedPath Dir)
pkgDirs) forall a b. (a -> b) -> a -> b
$
                            forall a. (?callStack::CallStack) => FilePath -> a
error FilePath
"Bug: No packages to ignore"

                        if forall (t :: * -> *) a. Foldable t => t a -> Int
length [PackageName]
ignored forall a. Ord a => a -> a -> Bool
> Int
1 then do
                          forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"*** Ignoring packages:"
                          forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Utf8Builder
display forall a b. (a -> b) -> a -> b
$ Text -> Text
indent forall a b. (a -> b) -> a -> b
$ [FilePath] -> Text
showItems forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PackageName -> FilePath
packageNameString [PackageName]
ignored
                        else
                          forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"*** Ignoring package: "
                                 forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => FilePath -> a
fromString
                                      (case [PackageName]
ignored of
                                        [] -> forall a. (?callStack::CallStack) => FilePath -> a
error FilePath
"getWorkingResolverPlan.head"
                                        PackageName
x:[PackageName]
_ -> PackageName -> FilePath
packageNameString PackageName
x)

                        Map PackageName (ResolvedPath Dir)
-> RIO
     env
     (RawSnapshotLocation, Map PackageName (Map FlagName Bool),
      Map PackageName Version, Map PackageName (ResolvedPath Dir))
go Map PackageName (ResolvedPath Dir)
available
                    where
                      indent :: Text -> Text
indent Text
t   = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
"    " forall a. Semigroup a => a -> a -> a
<>) (Text -> [Text]
T.lines Text
t)
                      isAvailable :: PackageName -> ResolvedPath Dir -> Bool
isAvailable PackageName
k ResolvedPath Dir
_ = PackageName
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageName]
ignored
                      available :: Map PackageName (ResolvedPath Dir)
available       = forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey PackageName -> ResolvedPath Dir -> Bool
isAvailable Map PackageName (ResolvedPath Dir)
pkgDirs

checkBundleResolver
    :: (HasConfig env, HasGHCVariant env)
    => InitOpts
    -> RawSnapshotLocation
    -> SnapshotCandidate env
    -> [ResolvedPath Dir]
    -- ^ Src package dirs

    -> RIO env
         (Either [PackageName] ( Map PackageName (Map FlagName Bool)
                               , Map PackageName Version))
checkBundleResolver :: forall env.
(HasConfig env, HasGHCVariant env) =>
InitOpts
-> RawSnapshotLocation
-> SnapshotCandidate env
-> [ResolvedPath Dir]
-> RIO
     env
     (Either
        [PackageName]
        (Map PackageName (Map FlagName Bool), Map PackageName Version))
checkBundleResolver InitOpts
initOpts RawSnapshotLocation
snapshotLoc SnapshotCandidate env
snapCandidate [ResolvedPath Dir]
pkgDirs = do
    BuildPlanCheck
result <- forall env.
(HasConfig env, HasGHCVariant env) =>
[ResolvedPath Dir]
-> Maybe (Map PackageName (Map FlagName Bool))
-> SnapshotCandidate env
-> RIO env BuildPlanCheck
checkSnapBuildPlan [ResolvedPath Dir]
pkgDirs forall a. Maybe a
Nothing SnapshotCandidate env
snapCandidate
    case BuildPlanCheck
result of
        BuildPlanCheckOk Map PackageName (Map FlagName Bool)
f -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Map PackageName (Map FlagName Bool)
f, forall k a. Map k a
Map.empty)
        BuildPlanCheckPartial Map PackageName (Map FlagName Bool)
_f DepErrors
e -> do -- FIXME:qrilka unused f

            if InitOpts -> Bool
omitPackages InitOpts
initOpts
                then do
                    BuildPlanCheck -> RIO env ()
warnPartial BuildPlanCheck
result
                    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"*** Omitting packages with unsatisfied dependencies"
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall {k}. Map k DepError -> [PackageName]
failedUserPkgs DepErrors
e
                else forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ RawSnapshotLocation -> FilePath -> ConfigException
ResolverPartial RawSnapshotLocation
snapshotLoc (forall a. Show a => a -> FilePath
show BuildPlanCheck
result)
        BuildPlanCheckFail Map PackageName (Map FlagName Bool)
_ DepErrors
e ActualCompiler
_
            | InitOpts -> Bool
omitPackages InitOpts
initOpts -> do
                forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"*** Resolver compiler mismatch: "
                           forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawSnapshotLocation
snapshotLoc
                forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Utf8Builder
display forall a b. (a -> b) -> a -> b
$ Text -> Text
indent forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show BuildPlanCheck
result
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall {k}. Map k DepError -> [PackageName]
failedUserPkgs DepErrors
e
            | Bool
otherwise -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ RawSnapshotLocation -> FilePath -> ConfigException
ResolverMismatch RawSnapshotLocation
snapshotLoc (forall a. Show a => a -> FilePath
show BuildPlanCheck
result)
    where
      indent :: Text -> Text
indent Text
t  = [Text] -> Text
T.unlines forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
"    " forall a. Semigroup a => a -> a -> a
<>) (Text -> [Text]
T.lines Text
t)
      warnPartial :: BuildPlanCheck -> RIO env ()
warnPartial BuildPlanCheck
res = do
          forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ Utf8Builder
"*** Resolver " forall a. Semigroup a => a -> a -> a
<> forall a. Display a => a -> Utf8Builder
display RawSnapshotLocation
snapshotLoc
                      forall a. Semigroup a => a -> a -> a
<> Utf8Builder
" will need external packages: "
          forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ forall a. Display a => a -> Utf8Builder
display forall a b. (a -> b) -> a -> b
$ Text -> Text
indent forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show BuildPlanCheck
res

      failedUserPkgs :: Map k DepError -> [PackageName]
failedUserPkgs Map k DepError
e = forall k a. Map k a -> [k]
Map.keys forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions (forall k a. Map k a -> [a]
Map.elems (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DepError -> Map PackageName VersionRange
deNeededBy Map k DepError
e))

getRecommendedSnapshots :: Snapshots -> NonEmpty SnapName
getRecommendedSnapshots :: Snapshots -> NonEmpty SnapName
getRecommendedSnapshots Snapshots
snapshots =
    -- in order - Latest LTS, Latest Nightly, all LTS most recent first

    case forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [SnapName]
supportedLtss of
        Just (SnapName
mostRecent :| [SnapName]
older)
            -> SnapName
mostRecent forall a. a -> [a] -> NonEmpty a
:| (SnapName
nightly forall a. a -> [a] -> [a]
: [SnapName]
older)
        Maybe (NonEmpty SnapName)
Nothing
            -> SnapName
nightly forall a. a -> [a] -> NonEmpty a
:| []
  where
    ltss :: [SnapName]
ltss = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> SnapName
LTS) (forall a. IntMap a -> [(Int, a)]
IntMap.toDescList forall a b. (a -> b) -> a -> b
$ Snapshots -> IntMap Int
snapshotsLts Snapshots
snapshots)
    supportedLtss :: [SnapName]
supportedLtss = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> a -> Bool
>= SnapName
minSupportedLts) [SnapName]
ltss
    nightly :: SnapName
nightly = Day -> SnapName
Nightly (Snapshots -> Day
snapshotsNightly Snapshots
snapshots)

-- |Yields the minimum LTS supported by stack.

minSupportedLts :: SnapName
minSupportedLts :: SnapName
minSupportedLts = Int -> Int -> SnapName
LTS Int
3 Int
0 -- See https://github.com/commercialhaskell/stack/blob/master/ChangeLog.md

                          -- under stack version 2.1.1.


data InitOpts = InitOpts
    { InitOpts -> [Text]
searchDirs     :: ![T.Text]
    -- ^ List of sub directories to search for .cabal files

    , InitOpts -> Bool
omitPackages   :: Bool
    -- ^ Exclude conflicting or incompatible user packages

    , InitOpts -> Bool
forceOverwrite :: Bool
    -- ^ Overwrite existing stack.yaml

    , InitOpts -> Bool
includeSubDirs :: Bool
    -- ^ If True, include all .cabal files found in any sub directories

    }

findCabalDirs
  :: HasConfig env
  => Bool -> Path Abs Dir -> RIO env (Set (Path Abs Dir))
findCabalDirs :: forall env.
HasConfig env =>
Bool -> Path Abs Dir -> RIO env (Set (Path Abs Dir))
findCabalDirs Bool
recurse Path Abs Dir
dir =
    forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall b t. Path b t -> Path b Dir
parent
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Path Abs Dir
-> (Path Abs File -> Bool)
-> (Path Abs Dir -> Bool)
-> IO [Path Abs File]
findFiles Path Abs Dir
dir forall {b}. Path b File -> Bool
isHpackOrCabal Path Abs Dir -> Bool
subdirFilter)
  where
    subdirFilter :: Path Abs Dir -> Bool
subdirFilter Path Abs Dir
subdir = Bool
recurse Bool -> Bool -> Bool
&& Bool -> Bool
not (forall {b}. Path b Dir -> Bool
isIgnored Path Abs Dir
subdir)
    isHpack :: Path b File -> Bool
isHpack = (forall a. Eq a => a -> a -> Bool
== FilePath
"package.yaml")     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Path b File -> Path Rel File
filename
    isCabal :: Path b t -> Bool
isCabal = (FilePath
".cabal" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath
    isHpackOrCabal :: Path b File -> Bool
isHpackOrCabal Path b File
x = forall {b}. Path b File -> Bool
isHpack Path b File
x Bool -> Bool -> Bool
|| forall {b} {t}. Path b t -> Bool
isCabal Path b File
x

    isIgnored :: Path b Dir -> Bool
isIgnored Path b Dir
path = FilePath
"." forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
dirName Bool -> Bool -> Bool
|| FilePath
dirName forall a. Ord a => a -> Set a -> Bool
`Set.member` Set FilePath
ignoredDirs
      where
        dirName :: FilePath
dirName = FilePath -> FilePath
FP.dropTrailingPathSeparator (forall b t. Path b t -> FilePath
toFilePath (forall b. Path b Dir -> Path Rel Dir
dirname Path b Dir
path))

-- | Special directories that we don't want to traverse for .cabal files

ignoredDirs :: Set FilePath
ignoredDirs :: Set FilePath
ignoredDirs = forall a. Ord a => [a] -> Set a
Set.fromList
    [ FilePath
"dist"
    ]

cabalPackagesCheck
    :: (HasConfig env, HasGHCVariant env)
     => [Path Abs Dir]
     -> Maybe String
     -> RIO env
          ( Map PackageName (Path Abs File, C.GenericPackageDescription)
          , [Path Abs File])
cabalPackagesCheck :: forall env.
(HasConfig env, HasGHCVariant env) =>
[Path Abs Dir]
-> Maybe FilePath
-> RIO
     env
     (Map PackageName (Path Abs File, GenericPackageDescription),
      [Path Abs File])
cabalPackagesCheck [Path Abs Dir]
cabaldirs Maybe FilePath
dupErrMsg = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Abs Dir]
cabaldirs) forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"We didn't find any local package directories"
      forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"You may want to create a package with \"stack new\" instead"
      forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"Create an empty project for now"
      forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn Utf8Builder
"If this isn't what you want, please delete the generated \"stack.yaml\""

    [FilePath]
relpaths <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *) r t.
(MonadIO m, RelPath (Path r t) ~ Path Rel t, AnyPath (Path r t)) =>
Path r t -> m FilePath
prettyPath [Path Abs Dir]
cabaldirs
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logInfo Utf8Builder
"Using cabal packages:"
    forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ [FilePath] -> Utf8Builder
formatGroup [FilePath]
relpaths

    [(Path Abs File, GenericPackageDescription)]
packages <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Path Abs Dir]
cabaldirs forall a b. (a -> b) -> a -> b
$ \Path Abs Dir
dir -> do
      (PrintWarnings -> IO GenericPackageDescription
gpdio, PackageName
_name, Path Abs File
cabalfp) <- forall env.
(HasPantryConfig env, HasLogFunc env, HasProcessContext env) =>
Path Abs Dir
-> RIO
     env
     (PrintWarnings -> IO GenericPackageDescription, PackageName,
      Path Abs File)
loadCabalFilePath Path Abs Dir
dir
      GenericPackageDescription
gpd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ PrintWarnings -> IO GenericPackageDescription
gpdio PrintWarnings
YesPrintWarnings
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs File
cabalfp, GenericPackageDescription
gpd)

    -- 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 normalizeString :: FilePath -> FilePath
normalizeString = Text -> FilePath
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizationMode -> Text -> Text
T.normalize NormalizationMode
T.NFC forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack
        getNameMismatchPkg :: (Path b t, GenericPackageDescription) -> Maybe (Path b t)
getNameMismatchPkg (Path b t
fp, GenericPackageDescription
gpd)
            | (FilePath -> FilePath
normalizeString forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> FilePath
packageNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> PackageName
gpdPackageName) GenericPackageDescription
gpd forall a. Eq a => a -> a -> Bool
/= (FilePath -> FilePath
normalizeString forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
FP.takeBaseName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath) Path b t
fp
                = forall a. a -> Maybe a
Just Path b t
fp
            | Bool
otherwise = forall a. Maybe a
Nothing
        nameMismatchPkgs :: [Path Abs File]
nameMismatchPkgs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {b} {t}.
(Path b t, GenericPackageDescription) -> Maybe (Path b t)
getNameMismatchPkg [(Path Abs File, GenericPackageDescription)]
packages

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Path Abs File]
nameMismatchPkgs forall a. Eq a => a -> a -> Bool
/= []) forall a b. (a -> b) -> a -> b
$ do
        [FilePath]
rels <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall (m :: * -> *) r t.
(MonadIO m, RelPath (Path r t) ~ Path Rel t, AnyPath (Path r t)) =>
Path r t -> m FilePath
prettyPath [Path Abs File]
nameMismatchPkgs
        forall a. (?callStack::CallStack) => FilePath -> a
error forall a b. (a -> b) -> a -> b
$ FilePath
"Package name as defined in the .cabal file must match the " forall a. Semigroup a => a -> a -> a
<>
                FilePath
".cabal file name.\n" forall a. Semigroup a => a -> a -> a
<>
                FilePath
"Please fix the following packages and try again:\n"
                forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Utf8Builder -> Text
utf8BuilderToText ([FilePath] -> Utf8Builder
formatGroup [FilePath]
rels))

    let dupGroups :: [(a, GenericPackageDescription)]
-> [[(a, GenericPackageDescription)]]
dupGroups = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Ord a => a -> a -> Bool
> Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length)
                            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [[a]]
groupSortOn (GenericPackageDescription -> PackageName
gpdPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
        dupAll :: [(Path Abs File, GenericPackageDescription)]
dupAll    = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall {a}.
[(a, GenericPackageDescription)]
-> [[(a, GenericPackageDescription)]]
dupGroups [(Path Abs File, GenericPackageDescription)]
packages

        -- Among duplicates prefer to include the ones in upper level dirs

        pathlen :: (Path b t, b) -> Int
pathlen     = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
FP.splitPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
        getmin :: [(Path b t, b)] -> (Path b t, b)
getmin      = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall {b} {t} {b}. (Path b t, b) -> Int
pathlen)
        dupSelected :: [(Path Abs File, GenericPackageDescription)]
dupSelected = forall a b. (a -> b) -> [a] -> [b]
map forall {b} {t} {b}. [(Path b t, b)] -> (Path b t, b)
getmin (forall {a}.
[(a, GenericPackageDescription)]
-> [[(a, GenericPackageDescription)]]
dupGroups [(Path Abs File, GenericPackageDescription)]
packages)
        dupIgnored :: [(Path Abs File, GenericPackageDescription)]
dupIgnored  = [(Path Abs File, GenericPackageDescription)]
dupAll forall a. Eq a => [a] -> [a] -> [a]
\\ [(Path Abs File, GenericPackageDescription)]
dupSelected
        unique :: [(Path Abs File, GenericPackageDescription)]
unique      = [(Path Abs File, GenericPackageDescription)]
packages forall a. Eq a => [a] -> [a] -> [a]
\\ [(Path Abs File, GenericPackageDescription)]
dupIgnored

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(Path Abs File, GenericPackageDescription)]
dupIgnored forall a. Eq a => a -> a -> Bool
/= []) forall a b. (a -> b) -> a -> b
$ do
        [[FilePath]]
dups <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (m :: * -> *) r t.
(MonadIO m, RelPath (Path r t) ~ Path Rel t, AnyPath (Path r t)) =>
Path r t -> m FilePath
prettyPathforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)) (forall {a}.
[(a, GenericPackageDescription)]
-> [[(a, GenericPackageDescription)]]
dupGroups [(Path Abs File, GenericPackageDescription)]
packages)
        forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$
            Utf8Builder
"Following packages have duplicate package names:\n" forall a. Semigroup a => a -> a -> a
<>
            forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Utf8Builder
"\n" (forall a b. (a -> b) -> [a] -> [b]
map [FilePath] -> Utf8Builder
formatGroup [[FilePath]]
dups))
        case Maybe FilePath
dupErrMsg of
          Maybe FilePath
Nothing -> forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasLogFunc env,
 ?callStack::CallStack) =>
Utf8Builder -> m ()
logWarn forall a b. (a -> b) -> a -> b
$
                 Utf8Builder
"Packages with duplicate names will be ignored.\n"
              forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"Packages in upper level directories will be preferred.\n"
          Just FilePath
msg -> forall a. (?callStack::CallStack) => FilePath -> a
error FilePath
msg

    forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Path Abs File
file, GenericPackageDescription
gpd) -> (GenericPackageDescription -> PackageName
gpdPackageName GenericPackageDescription
gpd,(Path Abs File
file, GenericPackageDescription
gpd))) [(Path Abs File, GenericPackageDescription)]
unique
           , forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Path Abs File, GenericPackageDescription)]
dupIgnored)

formatGroup :: [String] -> Utf8Builder
formatGroup :: [FilePath] -> Utf8Builder
formatGroup = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\FilePath
path -> Utf8Builder
"- " forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => FilePath -> a
fromString FilePath
path forall a. Semigroup a => a -> a -> a
<> Utf8Builder
"\n")

prettyPath ::
       (MonadIO m, RelPath (Path r t) ~ Path Rel t, AnyPath (Path r t))
    => Path r t
    -> m FilePath
prettyPath :: forall (m :: * -> *) r t.
(MonadIO m, RelPath (Path r t) ~ Path Rel t, AnyPath (Path r t)) =>
Path r t -> m FilePath
prettyPath Path r t
path = do
    Either PathException (Path Rel t)
eres <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try forall a b. (a -> b) -> a -> b
$ forall path (m :: * -> *).
(AnyPath path, MonadIO m) =>
path -> m (RelPath path)
makeRelativeToCurrentDir Path r t
path
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Either PathException (Path Rel t)
eres of
        Left (PathException
_ :: PathException) -> forall b t. Path b t -> FilePath
toFilePath Path r t
path
        Right Path Rel t
res -> forall b t. Path b t -> FilePath
toFilePath Path Rel t
res