Skip to content

Commit 8816aef

Browse files
committed
Cleaned up more warnings, doesn't compile
1 parent 2f64d8f commit 8816aef

19 files changed

Lines changed: 90 additions & 602 deletions

package.yaml

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -252,7 +252,6 @@ library:
252252
- Stack.Types.Package
253253
- Stack.Types.PackageDump
254254
- Stack.Types.PackageIdentifier
255-
- Stack.Types.PackageIndex
256255
- Stack.Types.PackageName
257256
- Stack.Types.Resolver
258257
- Stack.Types.Runner

src/Stack/Build/Cache.hs

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,6 @@ module Stack.Build.Cache
3535

3636
import Stack.Prelude
3737
import Crypto.Hash (hashWith, SHA256(..))
38-
import Control.Monad.Trans.Maybe
3938
import qualified Data.ByteArray as Mem (convert)
4039
import qualified Data.ByteString.Base64.URL as B64URL
4140
import qualified Data.ByteString as B
@@ -48,9 +47,6 @@ import qualified Data.Set as Set
4847
import qualified Data.Store as Store
4948
import Data.Store.VersionTagged
5049
import qualified Data.Text as T
51-
import qualified Data.Text.Encoding as TE
52-
import Pantry (PackageLocation (..), Archive (..), Repo (..))
53-
import Pantry.StaticSHA256
5450
import Path
5551
import Path.IO
5652
import Stack.Constants.Config

src/Stack/BuildPlan.hs

Lines changed: 8 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -335,13 +335,12 @@ instance Show BuildPlanCheck where
335335
-- the packages.
336336
checkSnapBuildPlan
337337
:: (HasConfig env, HasGHCVariant env)
338-
=> Path Abs Dir -- ^ project root, used for checking out necessary files
339-
-> [GenericPackageDescription]
338+
=> [GenericPackageDescription]
340339
-> Maybe (Map PackageName (Map FlagName Bool))
341340
-> SnapshotDef
342341
-> Maybe ActualCompiler
343342
-> RIO env BuildPlanCheck
344-
checkSnapBuildPlan root gpds flags snapshotDef mactualCompiler = do
343+
checkSnapBuildPlan gpds flags snapshotDef mactualCompiler = do
345344
platform <- view platformL
346345
rs <- loadSnapshot mactualCompiler snapshotDef
347346

@@ -372,16 +371,16 @@ checkSnapBuildPlan root gpds flags snapshotDef mactualCompiler = do
372371
-- best as possible with the given 'GenericPackageDescription's.
373372
selectBestSnapshot
374373
:: (HasConfig env, HasGHCVariant env)
375-
=> Path Abs Dir -- ^ project root, used for checking out necessary files
376-
-> [GenericPackageDescription]
374+
=> [GenericPackageDescription]
377375
-> NonEmpty SnapName
378376
-> RIO env (SnapshotDef, BuildPlanCheck)
379-
selectBestSnapshot root gpds snaps = do
377+
selectBestSnapshot gpds snaps = do
380378
logInfo $ "Selecting the best among "
381379
<> displayShow (NonEmpty.length snaps)
382380
<> " snapshots...\n"
383-
undefined {- FIXME
384-
F.foldr1 go (NonEmpty.map (getResult <=< loadResolver . ResolverStackage) snaps)
381+
let resolverStackage (LTS x y) = ltsSnapshotLocation x y
382+
resolverStackage (Nightly d) = nightlySnapshotLocation d
383+
F.foldr1 go (NonEmpty.map (getResult <=< loadResolver . snd . resolverStackage) snaps)
385384
where
386385
go mold mnew = do
387386
old@(_snap, bpc) <- mold
@@ -390,7 +389,7 @@ selectBestSnapshot root gpds snaps = do
390389
_ -> fmap (betterSnap old) mnew
391390

392391
getResult snap = do
393-
result <- checkSnapBuildPlan root gpds Nothing snap
392+
result <- checkSnapBuildPlan gpds Nothing snap
394393
-- We know that we're only dealing with ResolverStackage
395394
-- here, where we can rely on the global package hints.
396395
-- Therefore, we don't use an actual compiler. For more
@@ -417,7 +416,6 @@ selectBestSnapshot root gpds snaps = do
417416
logWarn $ RIO.display $ indent $ T.pack $ show r
418417

419418
indent t = T.unlines $ fmap (" " <>) (T.lines t)
420-
-}
421419

422420
showItems :: Show a => [a] -> Text
423421
showItems items = T.concat (map formatItem items)

src/Stack/Config.hs

Lines changed: 18 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@ import GHC.Conc (getNumProcessors)
6868
import Lens.Micro (lens, set)
6969
import Network.HTTP.StackClient (httpJSON, parseUrlThrow, getResponseBody)
7070
import Options.Applicative (Parser, strOption, long, help)
71-
import Pantry (HasPantryConfig (..), withPantryConfig, defaultHackageSecurityConfig, PackageLocation)
71+
import Pantry.StaticSHA256
7272
import Path
7373
import Path.Extra (toFilePathNoTrailingSep)
7474
import Path.Find (findInParents)
@@ -82,8 +82,6 @@ import Stack.Constants
8282
import qualified Stack.Image as Image
8383
import Stack.Package (parseSingleCabalFile)
8484
import Stack.Snapshot
85-
import Stack.Types.BuildPlan
86-
import Stack.Types.Compiler
8785
import Stack.Types.Config
8886
import Stack.Types.Docker
8987
import Stack.Types.Nix
@@ -351,7 +349,6 @@ configFromConfigMonoid
351349
configDumpLogs = fromFirst DumpWarningLogs configMonoidDumpLogs
352350
configSaveHackageCreds = fromFirst True configMonoidSaveHackageCreds
353351
configHackageBaseUrl = fromFirst "https://hackage.haskell.org/" configMonoidHackageBaseUrl
354-
clIgnoreRevisionMismatch = fromFirst False configMonoidIgnoreRevisionMismatch
355352

356353
configAllowDifferentUser <-
357354
case getFirst configMonoidAllowDifferentUser of
@@ -363,13 +360,21 @@ configFromConfigMonoid
363360
configRunner' <- view runnerL
364361
let configRunner = set processContextL origEnv configRunner'
365362

363+
case getFirst configMonoidIgnoreRevisionMismatch of
364+
Nothing -> pure ()
365+
Just _ -> logWarn "You configured the ignore-revision-mismatch setting, but it is no longer used by Stack"
366+
367+
hsc <-
368+
case getFirst configMonoidPackageIndices of
369+
Nothing -> pure defaultHackageSecurityConfig
370+
Just [hsc] -> pure hsc
371+
Just x -> error $ "When overriding the default package index, you must provide exactly one value, received: " ++ show x
366372
withPantryConfig
367373
(configStackRoot </> $(mkRelDir "pantry"))
368-
(case getFirst configMonoidPackageIndices of
369-
Nothing -> defaultHackageSecurityConfig
370-
)
374+
hsc
371375
(maybe HpackBundled HpackCommand $ getFirst configMonoidOverrideHpack)
372-
$ \configPantryConfig -> inner Config {..}
376+
clConnectionCount
377+
(\configPantryConfig -> inner Config {..})
373378

374379
-- | Get the default location of the local programs directory.
375380
getDefaultLocalProgramsBase :: MonadThrow m
@@ -592,9 +597,10 @@ loadBuildConfig mproject maresolver mcompiler = do
592597

593598
extraPackageDBs <- mapM resolveDir' (projectExtraPackageDBs project)
594599

595-
packages <- for (projectPackages project) $ \fp -> do
596-
dir <- resolveDirWithRel (parent stackYamlFP) fp
597-
(dir,) <$> runOnce (parseSingleCabalFile True dir)
600+
packages <- for (projectPackages project) $ \fp@(RelFilePath t) -> do
601+
abs' <- resolveDir (parent stackYamlFP) (T.unpack t)
602+
let resolved = ResolvedPath fp abs'
603+
(resolved,) <$> runOnce (parseSingleCabalFile True resolved)
598604

599605
let deps = projectDependencies project
600606

@@ -642,7 +648,6 @@ getLocalPackages = do
642648
case mcached of
643649
Just cached -> return cached
644650
Nothing -> do
645-
root <- view projectRootL
646651
bc <- view buildConfigL
647652

648653
packages <- for (bcPackages bc) $ fmap (lpvName &&& id) . liftIO . snd
@@ -907,7 +912,7 @@ getFakeConfigPath
907912
getFakeConfigPath stackRoot ar = do
908913
asString <-
909914
case ar of
910-
ARResolver r -> undefined -- return $ T.unpack $ resolverRawName r
915+
ARResolver r -> pure $ T.unpack $ staticSHA256ToText $ mkStaticSHA256FromBytes $ encodeUtf8 $ utf8BuilderToText $ display r
911916
_ -> throwM $ InvalidResolverForNoLocalConfig $ show ar
912917
-- This takeWhile is an ugly hack. We don't actually need this
913918
-- path for anything useful. But if we take the raw value for

src/Stack/Config/Docker.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -22,11 +22,11 @@ dockerOptsFromMonoid
2222
-> Maybe AbstractResolver
2323
-> DockerOptsMonoid
2424
-> m DockerOpts
25-
dockerOptsFromMonoid mproject stackRoot maresolver DockerOptsMonoid{..} = do
25+
dockerOptsFromMonoid _mproject stackRoot _maresolver DockerOptsMonoid{..} = do
2626
let dockerEnable =
2727
fromFirst (getAny dockerMonoidDefaultEnable) dockerMonoidEnable
2828
dockerImage =
29-
let mresolver = undefined
29+
let mresolver = undefined -- FIXME
3030
{-
3131
case maresolver of
3232
Just (ARResolver resolver) -> Just resolver
@@ -39,7 +39,7 @@ dockerOptsFromMonoid mproject stackRoot maresolver DockerOptsMonoid{..} = do
3939
defaultTag =
4040
case mresolver of
4141
Nothing -> ""
42-
Just resolver ->
42+
Just _resolver ->
4343
error "FIXME need some logic for figuring out we're using an LTS now"
4444
{-
4545
case resolver of

src/Stack/Config/Nix.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,6 @@ import qualified Data.Text.IO as TIO
1515
import Distribution.System (OS (..))
1616
import Stack.Constants
1717
import Stack.Types.Nix
18-
import Stack.Types.Compiler
1918
import Stack.Types.Runner
2019
import System.Directory (doesFileExist)
2120

src/Stack/Options/ResolverParser.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,6 @@ import Options.Applicative
77
import Options.Applicative.Types (readerAsk)
88
import Stack.Options.Utils
99
import Stack.Prelude
10-
import Stack.Types.Compiler
1110
import Stack.Types.Resolver
1211

1312
-- | Parser for the resolver

src/Stack/Package.hs

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,6 @@ module Stack.Package
3434
,parseSingleCabalFile)
3535
where
3636

37-
import qualified Data.ByteString as BS
3837
import qualified Data.ByteString.Lazy.Char8 as CL8
3938
import Data.List (isSuffixOf, isPrefixOf, unzip)
4039
import Data.Maybe (maybe)
@@ -52,7 +51,6 @@ import qualified Distribution.PackageDescription as D
5251
import Distribution.PackageDescription hiding (FlagName)
5352
import Distribution.PackageDescription.Parsec
5453
import qualified Distribution.PackageDescription.Parsec as D
55-
import Distribution.Parsec.Common (PWarning (..), showPos)
5654
import Distribution.Simple.Utils
5755
import Distribution.System (OS (..), Arch, Platform (..))
5856
import qualified Distribution.Text as D
@@ -64,11 +62,9 @@ import Distribution.Types.MungedPackageName
6462
import qualified Distribution.Types.UnqualComponentName as Cabal
6563
import qualified Distribution.Verbosity as D
6664
import Lens.Micro (lens)
67-
import qualified Hpack
6865
import qualified Hpack.Config as Hpack
6966
import Path as FL
7067
import Path.Extra
71-
import Path.Find
7268
import Path.IO hiding (findFiles)
7369
import Stack.Build.Installed
7470
import Stack.Constants

src/Stack/PackageDump.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ ghcPkgDescribe
6767
-> [Path Abs Dir] -- ^ if empty, use global
6868
-> ConduitM Text Void (RIO env) a
6969
-> RIO env a
70-
ghcPkgDescribe pkgName = ghcPkgCmdArgs ["describe", "--simple-output", displayC pkgName]
70+
ghcPkgDescribe pkgName' = ghcPkgCmdArgs ["describe", "--simple-output", displayC pkgName']
7171

7272
-- | Call ghc-pkg and stream to the given @Sink@, for a single database
7373
ghcPkgCmdArgs

src/Stack/PrettyPrint.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE NoImplicitPrelude #-}
2+
{-# OPTIONS_GHC -fno-warn-orphans #-}
23
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE FlexibleInstances #-}
45
{-# LANGUAGE OverloadedStrings #-}

0 commit comments

Comments
 (0)