Enable spago install to work on advanced Dhall expressions

CHANGELOG.md

@@ -7,6 +7,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+New Features
+- `spago install` works on more advanced Dhall expressions as stored in `spago.dhall (#849)
+
 ## [0.20.4] - 2022-01-29
 
 Bugfixes:

spago.cabal

@@ -92,6 +92,7 @@ library
     Spago.Command.Path
     Spago.Command.Verify
     Spago.Config
+    Spago.Config.AST
     Spago.Dhall
     Spago.DryRun
     Spago.Env

src/Spago/Dhall.hs

@@ -177,6 +177,8 @@ data ReadError a where
  -- | a key is missing from a Dhall map
  RequiredKeyMissing    :: Typeable a => Text -> Dhall.Map.Map Text (DhallExpr a) -> ReadError a
 
+deriving instance (Eq a) => Eq (ReadError a)
+
 instance (Pretty a, Typeable a) => Exception (ReadError a)
 
 instance (Pretty a) => Show (ReadError a) where

src/Spago/Messages.hs

@@ -2,6 +2,7 @@ module Spago.Messages where
 
 import           Spago.Prelude
 
+import qualified Data.Set           as Set
 import qualified Data.List.NonEmpty as NonEmpty
 import qualified Data.Text          as Text
 
@@ -131,13 +132,13 @@ failedToReachGitHub err = makeMessage
   , tshow err
   ]
 
-failedToAddDeps :: NonEmpty Text -> Text
+failedToAddDeps :: Set Text -> Text
 failedToAddDeps pkgs = makeMessage $
   [ "Some of the dependencies you tried to add were not found in the package-set."
   , "Not adding any new dependencies to your new spago config."
   , "We didn't find:"
   ]
-  <> map ("- " <>) (NonEmpty.toList pkgs)
+  <> map ("- " <>) (Set.toList pkgs)
   <> [""]
 
 updatingPackageSet :: Text -> Text

src/Spago/Packages.hs

@@ -163,7 +163,7 @@ install newPackages = do
     -- Also skip the write if there are no new packages to be written
     case existingNewPackages of
       []         -> pure ()
-      additional -> Config.addDependencies config additional
+      additional -> Config.addDependencies config $ Set.fromList additional
 
     Fetch.fetchPackages deps
 

src/Spago/Prelude.hs

@@ -13,6 +13,7 @@ module Spago.Prelude
   , lastMay
   , empty
   , ifM
+  , nubSeq
 
   -- * Logging, errors, printing, etc
   , Pretty
@@ -122,6 +123,8 @@ import qualified Data.ByteString.Lazy as BSL
 import qualified Data.ByteString.Search as BSS
 import qualified Data.ByteString.UTF8 as UTF8
 import qualified System.IO as IO
+import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
 
 
 -- | Generic Error that we throw on program exit.
@@ -150,6 +153,15 @@ ifM p x y = p >>= \b -> if b then x else y
 hush :: Either a b -> Maybe b
 hush = either (const Nothing) Just
 
+-- |
+-- Removes duplicate elements in a @Seq@.
+--
+-- Code from https://stackoverflow.com/questions/45757839
+nubSeq :: Ord a => Seq a -> Seq a
+nubSeq xs = (fmap fst . Seq.filter (uncurry notElem)) (Seq.zip xs seens)
+  where
+    seens = Seq.scanl (flip Set.insert) Set.empty xs
+
 pathFromText :: Text -> Turtle.FilePath
 pathFromText = Turtle.fromText
 

src/Spago/RunEnv.hs

@@ -8,6 +8,7 @@ import qualified System.Environment  as Env
 import qualified RIO
 import qualified System.Info
 import qualified Turtle
+import qualified Data.Set as Set
 
 import qualified Spago.Config as Config
 import qualified Spago.GlobalCache as Cache
@@ -205,7 +206,7 @@ getPackageSet = do
 getMaybeGraph :: HasPursEnv env => BuildOptions -> Config -> [(PackageName, Package)] -> RIO env Graph
 getMaybeGraph BuildOptions{ depsOnly, sourcePaths } Config{ configSourcePaths } deps = do
   logDebug "Running `getMaybeGraph`"
-  let partitionedGlobs = Packages.getGlobs deps depsOnly $ toList configSourcePaths
+  let partitionedGlobs = Packages.getGlobs deps depsOnly $ Set.toList configSourcePaths
       globs = Packages.getGlobsSourcePaths partitionedGlobs <> sourcePaths
   supportsGraph <- Purs.hasMinPursVersion "0.14.0"
   if not supportsGraph

src/Spago/Types.hs

@@ -50,7 +50,7 @@ data PackageSet = PackageSet
   { packagesDB             :: Map PackageName Package
   , packagesMinPursVersion :: Maybe Version.SemVer
   }
-  deriving (Show, Generic)
+  deriving (Eq, Show, Generic)
 
 
 -- | We consider a "Repo" a "box of source to include in the build"
@@ -190,14 +190,14 @@ data Config = Config
   , alternateBackend  :: Maybe Text
   , configSourcePaths :: Set SourcePath
   , publishConfig     :: Either (Dhall.ReadError Void) PublishConfig
-  } deriving (Show, Generic)
+  } deriving (Eq, Show, Generic)
 
 
 -- | The extra fields that are only needed for publishing libraries.
 data PublishConfig = PublishConfig
   { publishLicense    :: Text
   , publishRepository :: Text
-  } deriving (Show, Generic)
+  } deriving (Eq, Show, Generic)
 
 data PursCmd = PursCmd
   { purs :: Text