Refactor internal environments handling

app/Spago.hs

@@ -10,7 +10,6 @@ import           Spago.CLI           (Command(..))
 
 import qualified System.Environment  as Env
 import qualified Spago.Build
-import qualified Spago.GitHub
 import qualified Spago.Messages      as Messages
 import qualified Spago.Packages
 import qualified Spago.PackageSet
@@ -51,14 +50,16 @@ main = withUtf8 $ do
         -> Spago.PackageSet.updatePackageSetVersion tag
       Freeze
         -> Spago.PackageSet.freeze Spago.PackageSet.packagesPath
-      Login 
-        -> Spago.GitHub.login
       Version
         -> CLI.echo spagoVersion
-      Path whichPath buildOptions 
+      Path whichPath buildOptions
         -> Path.showPaths buildOptions whichPath
       Repl replPackageNames paths pursArgs depsOnly
         -> Spago.Build.repl replPackageNames paths pursArgs depsOnly
+      BundleApp modName tPath shouldBuild buildOptions
+        -> Spago.Build.bundleApp WithMain modName tPath shouldBuild buildOptions globalUsePsa
+      BundleModule modName tPath shouldBuild buildOptions
+        -> Spago.Build.bundleModule modName tPath shouldBuild buildOptions globalUsePsa
 
       -- ### Commmands that need only a Package Set
       ListPackages jsonFlag -> Run.withPackageSetEnv
@@ -67,38 +68,32 @@ main = withUtf8 $ do
       -- ### Commands that need an "install environment": global options and a Config
       Install packageNames -> Run.withInstallEnv
         $ Spago.Packages.install packageNames
-      ListDeps jsonFlag transitiveFlag -> Run.withInstallEnv 
+      ListDeps jsonFlag transitiveFlag -> Run.withInstallEnv
         $ Ls.listPackages transitiveFlag jsonFlag
-      Sources -> Run.withInstallEnv 
+      Sources -> Run.withInstallEnv
         $ Spago.Packages.sources
-      
+
       -- ### Commands that need a "publish env": install env + git and bower
-      BumpVersion dryRun spec -> Run.withPublishEnv 
+      BumpVersion dryRun spec -> Run.withPublishEnv
         $ Spago.Version.bumpVersion dryRun spec
-      
-      -- ### Commands that need a "verification env": a Package Set + purs 
+
+      -- ### Commands that need a "verification env": a Package Set + purs
       Verify package -> Run.withVerifyEnv globalUsePsa
         $ Verify.verify NoCheckModulesUnique (Just package)
       VerifySet checkUniqueModules -> Run.withVerifyEnv globalUsePsa
         $ Verify.verify checkUniqueModules Nothing
-      
+
       -- ### Commands that need a build environment: a config, build options and access to purs
       Build buildOptions -> Run.withBuildEnv globalUsePsa
         $ Spago.Build.build buildOptions Nothing
-      Search -> Run.withBuildEnv globalUsePsa 
+      Search -> Run.withBuildEnv globalUsePsa
         $ Spago.Build.search
-      Docs format sourcePaths depsOnly noSearch openDocs -> Run.withBuildEnv globalUsePsa 
+      Docs format sourcePaths depsOnly noSearch openDocs -> Run.withBuildEnv globalUsePsa
         $ Spago.Build.docs format sourcePaths depsOnly noSearch openDocs
-
-      -- TODO: Bundle env: build env + bundle options
       Test modName buildOptions nodeArgs -> Run.withBuildEnv globalUsePsa
         $ Spago.Build.test modName buildOptions nodeArgs
       Run modName buildOptions nodeArgs -> Run.withBuildEnv globalUsePsa
         $ Spago.Build.run modName buildOptions nodeArgs
-      BundleApp modName tPath shouldBuild buildOptions -> Run.withBuildEnv globalUsePsa
-        $ Spago.Build.bundleApp WithMain modName tPath shouldBuild buildOptions
-      BundleModule modName tPath shouldBuild buildOptions -> Run.withBuildEnv globalUsePsa
-        $ Spago.Build.bundleModule modName tPath shouldBuild buildOptions
 
       -- ### Legacy commands, here for smoother migration path to new ones
       Bundle -> die [ display Messages.bundleCommandRenamed ]

package.yaml

@@ -12,6 +12,10 @@ extra-source-files:
 
 ghc-options:
   - -Wall
+  - -Wcompat
+  - -Wincomplete-record-updates
+  - -Wredundant-constraints
+  - -fprint-potential-instances
 
 flags:
   static:
@@ -41,6 +45,7 @@ default-extensions:
 - DeriveTraversable
 - DerivingStrategies
 - DoAndIfThenElse
+- DuplicateRecordFields
 - EmptyDataDecls
 - ExistentialQuantification
 - FlexibleContexts
@@ -51,21 +56,27 @@ default-extensions:
 - InstanceSigs
 - KindSignatures
 - LambdaCase
+- LiberalTypeSynonyms
+- MonadFailDesugaring
 - MultiParamTypeClasses
 - MultiWayIf
 - NamedFieldPuns
 - NoImplicitPrelude
+- NoMonomorphismRestriction
 - OverloadedStrings
 - PartialTypeSignatures
 - PatternGuards
 - PolyKinds
+- QuantifiedConstraints
 - RankNTypes
 - RecordWildCards
 - ScopedTypeVariables
 - StandaloneDeriving
 - TupleSections
+- TypeApplications
 - TypeFamilies
 - TypeSynonymInstances
+- UndecidableInstances
 - ViewPatterns
 
 
@@ -89,6 +100,7 @@ library:
   - filepath
   - foldl
   - fsnotify
+  - generic-lens
   - github
   - Glob
   - http-types

spago.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: b88f8100a3b763c486e0f8eef011ce424bcca172077abeb8b10114b874428683
+-- hash: 9de92542b083d8ac067f48da2712a1fb309797a50aa0494d1590a304f069b13e
 
 name:           spago
 version:        0.17.0
@@ -63,8 +63,8 @@ library
       Paths_spago
   hs-source-dirs:
       src
-  default-extensions: ApplicativeDo BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeSynonymInstances ViewPatterns
-  ghc-options: -Wall
+  default-extensions: ApplicativeDo BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse DuplicateRecordFields EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase LiberalTypeSynonyms MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds QuantifiedConstraints RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeSynonymInstances UndecidableInstances ViewPatterns
+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -fprint-potential-instances
   build-depends:
       Cabal
     , Glob
@@ -84,6 +84,7 @@ library
     , filepath
     , foldl
     , fsnotify
+    , generic-lens
     , github
     , http-client
     , http-conduit
@@ -125,8 +126,8 @@ executable spago
       Paths_spago
   hs-source-dirs:
       app
-  default-extensions: ApplicativeDo BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeSynonymInstances ViewPatterns
-  ghc-options: -Wall
+  default-extensions: ApplicativeDo BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse DuplicateRecordFields EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase LiberalTypeSynonyms MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds QuantifiedConstraints RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeSynonymInstances UndecidableInstances ViewPatterns
+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -fprint-potential-instances
   build-depends:
       base >=4.7 && <5
     , spago
@@ -147,16 +148,16 @@ test-suite spec
   other-modules:
       BumpVersionSpec
       Spago.Build.ParserSpec
-      Spago.Command.PathSpec
+      Spago.PursSpec
       SpagoSpec
       Spec
       UnitSpec
       Utils
       Paths_spago
   hs-source-dirs:
       test
-  default-extensions: ApplicativeDo BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeFamilies TypeSynonymInstances ViewPatterns
-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -main-is Main
+  default-extensions: ApplicativeDo BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies DoAndIfThenElse DuplicateRecordFields EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase LiberalTypeSynonyms MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds QuantifiedConstraints RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TupleSections TypeApplications TypeFamilies TypeSynonymInstances UndecidableInstances ViewPatterns
+  ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wredundant-constraints -fprint-potential-instances -threaded -rtsopts -with-rtsopts=-N -main-is Main
   build-depends:
       QuickCheck
     , base >=4.7 && <5

src/Spago/Async.hs

@@ -8,10 +8,10 @@ import Spago.Prelude
 import qualified Control.Concurrent.Async.Pool         as Async
 
 
-withTaskGroup :: (MonadIO m, MonadReader env m, HasLogFunc env, MonadUnliftIO m) => Int -> (Async.TaskGroup -> m b) -> m b
+withTaskGroup :: MonadUnliftIO m => Int -> (Async.TaskGroup -> m b) -> m b
 withTaskGroup n action = withRunInIO $ \run -> Async.withTaskGroup n (\taskGroup -> run $ action taskGroup)
 
-async :: (MonadIO m, MonadReader env m, HasLogFunc env, MonadUnliftIO m) => Async.TaskGroup -> m a -> m (Async.Async a)
+async :: MonadUnliftIO m => Async.TaskGroup -> m a -> m (Async.Async a)
 async taskGroup action = withRunInIO $ \run -> Async.async taskGroup (run action)
 
 wait :: MonadIO m => Async.Async a -> m a

src/Spago/Bower.hs

@@ -32,14 +32,14 @@ path = "bower.json"
 
 runBower :: HasBower env => [Text] -> RIO env (ExitCode, Text, Text)
 runBower args = do
-  bower <- view bowerL
+  BowerCmd bower <- view (the @BowerCmd)
   Turtle.procStrictWithErr bower args empty
 
 
 generateBowerJson :: HasPublishEnv env => RIO env Text
 generateBowerJson = do
   logInfo "Generating a new Bower config using the package set versions.."
-  Config{..} <- view configL
+  Config{..} <- view (the @Config)
   PublishConfig{..} <- throws publishConfig
 
   bowerName <- mkPackageName name
@@ -66,7 +66,7 @@ generateBowerJson = do
 runBowerInstall :: (HasLogFunc env, HasBower env) => RIO env ()
 runBowerInstall = do
   logInfo "Running `bower install` so `pulp publish` can read resolved versions from it"
-  bower <- view bowerL
+  BowerCmd bower <- view (the @BowerCmd)
   shell (bower <> " install --silent") empty >>= \case
     ExitSuccess   -> pure ()
     ExitFailure _ -> die [ "Failed to run `bower install` on your package" ]
@@ -118,7 +118,7 @@ mkDependencies
 mkDependencies = do
   deps <- Packages.getDirectDeps
 
-  jobs <- getJobs
+  Jobs jobs <- getJobs
 
   Async.withTaskGroup jobs $ \taskGroup ->
     Async.mapTasks taskGroup $ mkDependency <$> deps
@@ -137,5 +137,5 @@ mkDependencies = do
     getJobs = case OS.buildOS of
       -- Windows sucks so lets make it slow for them!
       -- (just kidding, its a bug: https://github.com/bower/spec/issues/79)
-      OS.Windows -> pure 1
-      _       -> view jobsL
+      OS.Windows -> pure $ Jobs 1
+      _          -> view (the @Jobs)