From 2337b6a89459d4ff3e57e1e4c99127140ea8e944 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Thu, 4 Jul 2019 12:52:29 +0200 Subject: [PATCH 01/16] Move surroundQuote to Prelude --- src/Spago/Messages.hs | 3 --- src/Spago/Prelude.hs | 5 +++++ 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Spago/Messages.hs b/src/Spago/Messages.hs index ea37bcb5a..dcad0a920 100644 --- a/src/Spago/Messages.hs +++ b/src/Spago/Messages.hs @@ -151,8 +151,5 @@ makeModuleCommandRenamed :: Text makeModuleCommandRenamed = "The `make-module` command has been replaced with `bundle-module`, so use that instead." -surroundQuote :: Text -> Text -surroundQuote y = "\"" <> y <> "\"" - makeMessage :: [Text] -> Text makeMessage = Text.intercalate "\n" diff --git a/src/Spago/Prelude.hs b/src/Spago/Prelude.hs index c713374d3..80a48fbd2 100644 --- a/src/Spago/Prelude.hs +++ b/src/Spago/Prelude.hs @@ -26,6 +26,7 @@ module Spago.Prelude , (<|>) , () , (^..) + , surroundQuote , transformMOf , testfile , testdir @@ -171,6 +172,10 @@ viewShell :: (MonadIO m, Show a) => Turtle.Shell a -> m () viewShell = Turtle.view +surroundQuote :: Text -> Text +surroundQuote y = "\"" <> y <> "\"" + + mv :: MonadIO m => System.IO.FilePath -> System.IO.FilePath -> m () mv from to = Turtle.mv (Turtle.decodeString from) (Turtle.decodeString to) From 606d999082fdbdbc95ce2643b95f494ec532d5ff Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Thu, 4 Jul 2019 13:37:04 +0200 Subject: [PATCH 02/16] Start parsing local packages refs with 'as Location' --- app/Curator.hs | 19 +++++----- package.yaml | 1 + src/Spago/Config.hs | 76 ++++++++++++++++++++++++++------------- src/Spago/Dhall.hs | 16 ++++----- src/Spago/FetchPackage.hs | 18 +++++----- src/Spago/GlobalCache.hs | 6 ++-- src/Spago/PackageSet.hs | 36 ++++++++++++------- src/Spago/Packages.hs | 36 ++++++++++++------- src/Spago/Prelude.hs | 10 +++--- src/Spago/PscPackage.hs | 9 +++-- src/Spago/Purs.hs | 6 ++-- stack.yaml | 10 ++++-- 12 files changed, 150 insertions(+), 93 deletions(-) diff --git a/app/Curator.hs b/app/Curator.hs index c78dd02e3..1cf0970b3 100644 --- a/app/Curator.hs +++ b/app/Curator.hs @@ -26,10 +26,11 @@ import qualified System.Environment as Env import qualified System.IO.Temp as Temp import qualified System.Process as Process import qualified Turtle +import qualified Spago.Config import Data.Aeson.Encode.Pretty (encodePretty) import Spago.GlobalCache -import Spago.PackageSet (Package (..), PackageName (..), Repo (..)) +import Spago.PackageSet (Package (..), PackageName (..), Repo (..), PackageLocation(..)) type Expr = Dhall.DhallExpr Dhall.Import type PackageSetMap = Map PackageName Package @@ -216,8 +217,8 @@ fetcher token controlChan metadataChan psChan = forever $ do where -- | Call GitHub to get metadata for a single package fetchRepoMetadata :: (PackageName, Package) -> IO () - fetchRepoMetadata (_, Package{ repo = Local _, ..}) = pure () - fetchRepoMetadata (packageName, Package{ repo = Remote repoUrl, .. }) = + fetchRepoMetadata (_, Package{ location = Local{..}, ..}) = pure () + fetchRepoMetadata (packageName, Package{ location = Remote{ repo = Repo repoUrl, ..}, ..}) = Retry.recoverAll (Retry.fullJitterBackoff 50000 <> Retry.limitRetries 25) $ \Retry.RetryStatus{..} -> do let !(owner:repo:_rest) = Text.split (=='/') @@ -251,13 +252,11 @@ fetcher token controlChan metadataChan psChan = forever $ do -- | Tries to read in a PackageSet from GitHub fetchPackageSet :: Text -> IO PackageSetMap fetchPackageSet tag = do - let packageTyp = Dhall.genericAuto :: Dhall.Type Package expr <- Dhall.inputExpr ("https://raw.githubusercontent.com/purescript/package-sets/" <> tag <> "/src/packages.dhall") - Right packageSet <- pure $ case expr of - Dhall.RecordLit pkgs -> (Map.mapKeys PackageName . Dhall.Map.toMap) - <$> traverse (Dhall.coerceToType packageTyp) pkgs - something -> Left $ Dhall.PackagesIsNotRecord something - pure packageSet + case expr of + Dhall.RecordLit pkgs -> fmap (Map.mapKeys PackageName . Dhall.Map.toMap) + $ traverse Spago.Config.parsePackage pkgs + something -> throwM $ Dhall.PackagesIsNotRecord something packageSetsUpdater :: Text -> Queue.TQueue PackageSetsUpdaterMessage -> IO () @@ -280,7 +279,7 @@ packageSetsUpdater token dataChan = go mempty mempty case Map.lookup packageName packageSet of -- We're only interested in the case in which the tag in the package set -- is different from the current tag. - Just Package{ version = version, .. } | version /= tag -> do + Just Package{ location = Remote{..}, .. } | version /= tag -> do echo $ "Found a newer tag for '" <> name <> "': " <> tag let auth = GitHub.OAuth $ Encoding.encodeUtf8 token owner' = GitHub.mkName Proxy "purescript" diff --git a/package.yaml b/package.yaml index 9fd65287f..516fb3309 100644 --- a/package.yaml +++ b/package.yaml @@ -45,6 +45,7 @@ library: - base >= 4.7 && < 5 - text < 1.3 - turtle + - either - filepath - file-embed - template-haskell diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index 16a473157..fe5b49895 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -3,6 +3,7 @@ module Spago.Config ( makeConfig , ensureConfig , addDependencies + , parsePackage , Config(..) ) where @@ -45,6 +46,35 @@ data Config = Config } deriving (Show, Generic) type Expr = Dhall.DhallExpr Dhall.Import +type ResolvedExpr = Dhall.DhallExpr Dhall.TypeCheck.X + + +isLocationType :: (Eq s, Eq a) => Dhall.Expr s a -> Bool +isLocationType (Dhall.Union kvs) | locationUnionMap == Dhall.Map.toMap kvs = True + where + locationUnionMap = Map.fromList + [ ("Environment", Just Dhall.Text) + , ("Remote", Just Dhall.Text) + , ("Local", Just Dhall.Text) + , ("Missing", Nothing) + ] +isLocationType _ = False + +parsePackage :: ResolvedExpr -> IO Package +parsePackage (Dhall.RecordLit ks) = do + let repoType = Dhall.auto :: Dhall.Type PackageSet.Repo + let dependenciesType = Dhall.list (Dhall.auto :: Dhall.Type PackageName) + repo <- Dhall.requireTypedKey ks "repo" repoType + version <- Dhall.requireTypedKey ks "version" Dhall.strictText + dependencies <- Dhall.requireTypedKey ks "dependencies" dependenciesType + let location = PackageSet.Remote{..} + pure PackageSet.Package{..} +parsePackage (Dhall.App (Dhall.Field union "Local") (Dhall.TextLit (Dhall.Chunks [] localPath))) + | isLocationType union = do + let dependencies = [] + let location = PackageSet.Local{..} + pure PackageSet.Package{..} +parsePackage _expr = die "errr" -- | Tries to read in a Spago Config parseConfig :: Spago m => m Config @@ -52,31 +82,27 @@ parseConfig = do withConfigAST $ pure . addSourcePaths expr <- liftIO $ Dhall.inputExpr $ "./" <> pathText case expr of - Dhall.RecordLit ks -> do - maybeConfig <- pure $ do - let packageTyp = Dhall.genericAuto :: Dhall.Type Package - packageNamesTyp = Dhall.list (Dhall.auto :: Dhall.Type PackageName) - sourcesType = Dhall.list (Dhall.auto :: Dhall.Type Purs.SourcePath) - name <- Dhall.requireTypedKey ks "name" Dhall.strictText - dependencies <- Dhall.requireTypedKey ks "dependencies" packageNamesTyp - packages <- Dhall.requireKey ks "packages" $ \case - Dhall.RecordLit pkgs -> (Map.mapKeys PackageSet.PackageName . Dhall.Map.toMap) - <$> traverse (Dhall.coerceToType packageTyp) pkgs - something -> Left $ Dhall.PackagesIsNotRecord something - configSourcePaths <- Dhall.requireTypedKey ks "sources" sourcesType - - let metadataPackageName = PackageSet.PackageName "metadata" - (metadataMap, packagesDB) = Map.partitionWithKey (\k _v -> k == metadataPackageName) packages - packagesMinPursVersion = join - $ fmap (hush . Version.semver . (Text.replace "v" "") . PackageSet.version) - $ Map.lookup metadataPackageName metadataMap - packageSet = PackageSet.PackageSet{..} - - Right $ Config{..} - - case maybeConfig of - Right config -> pure config - Left err -> throwM err + Dhall.RecordLit ks -> liftIO $ do + packages :: Map PackageName Package <- Dhall.requireKey ks "packages" (\case + Dhall.RecordLit pkgs -> + fmap (Map.mapKeys PackageSet.PackageName . Dhall.Map.toMap) + $ traverse parsePackage pkgs + something -> throwM $ Dhall.PackagesIsNotRecord something) + + let pkgNamesType = Dhall.list (Dhall.auto :: Dhall.Type PackageName) + let sourcesType = Dhall.list (Dhall.auto :: Dhall.Type Purs.SourcePath) + name <- Dhall.requireTypedKey ks "name" Dhall.strictText + dependencies <- Dhall.requireTypedKey ks "dependencies" pkgNamesType + configSourcePaths <- Dhall.requireTypedKey ks "sources" sourcesType + + let metadataPackageName = PackageSet.PackageName "metadata" + let (metadataMap, packagesDB) = Map.partitionWithKey (\k _v -> k == metadataPackageName) packages + let packagesMinPursVersion = join + $ fmap (hush . Version.semver . (Text.replace "v" "") . PackageSet.version . PackageSet.location) + $ Map.lookup metadataPackageName metadataMap + let packageSet = PackageSet.PackageSet{..} + + pure Config{..} _ -> case Dhall.TypeCheck.typeOf expr of Right e -> throwM $ Dhall.ConfigIsNotRecord e Left err -> throwM $ err diff --git a/src/Spago/Dhall.hs b/src/Spago/Dhall.hs index 59f9b6256..43c2e034e 100644 --- a/src/Spago/Dhall.hs +++ b/src/Spago/Dhall.hs @@ -77,14 +77,14 @@ fromTextLit expr = Left $ ExprIsNotTextLit expr -- | Require a key from a Dhall.Map, and run an action on it if found. -- If not found, return the name of the key. requireKey - :: (Typeable b) + :: (Typeable b, Pretty b) => Dhall.Map.Map Text (DhallExpr b) -> Text - -> (DhallExpr b -> Either (ReadError b) a) - -> Either (ReadError b) a + -> (DhallExpr b -> IO a) + -> IO a requireKey ks name f = case (Dhall.Map.lookup name ks) of Just v -> f v - Nothing -> Left $ RequiredKeyMissing name ks + Nothing -> throwM (RequiredKeyMissing name ks) -- | Same as `requireKey`, but we give it a Dhall.Type to automagically decode from @@ -92,10 +92,10 @@ requireTypedKey :: Dhall.Map.Map Text (DhallExpr Dhall.TypeCheck.X) -> Text -> Dhall.Type a - -> Either (ReadError Dhall.TypeCheck.X) a + -> IO a requireTypedKey ks name typ = requireKey ks name $ \expr -> case Dhall.extract typ expr of - Just v -> Right v - Nothing -> Left $ RequiredKeyMissing name ks + Success v -> pure v + Failure _ -> throwM $ RequiredKeyMissing name ks -- | Convert a Dhall expression to a given Dhall type @@ -110,7 +110,7 @@ coerceToType typ expr = do let annot = Dhall.Annot expr $ Dhall.expected typ let checkedType = typeOf annot case (Dhall.extract typ $ Dhall.normalize annot, checkedType) of - (Just x, Right _) -> Right x + (Success x, Right _) -> Right x _ -> Left $ WrongType typ expr diff --git a/src/Spago/FetchPackage.hs b/src/Spago/FetchPackage.hs index 3f25e20bf..d165c6f14 100644 --- a/src/Spago/FetchPackage.hs +++ b/src/Spago/FetchPackage.hs @@ -22,7 +22,7 @@ import qualified UnliftIO.Directory as Directory import qualified Spago.GlobalCache as GlobalCache import qualified Spago.Messages as Messages -import Spago.PackageSet (Package (..), PackageName (..), Repo (..)) +import Spago.PackageSet (Package (..), PackageName (..), Repo (..), PackageLocation(..)) import qualified Spago.PackageSet as PackageSet @@ -93,9 +93,9 @@ fetchPackages maybeLimit globalCacheFlag allDeps minPursVersion = do -- sensible to do so. -- If it's a local directory do nothing fetchPackage :: Spago m => GlobalCache.ReposMetadataV1 -> (PackageName, Package) -> m () -fetchPackage _ (PackageName package, Package { repo = Local path }) = - echo $ Messages.foundLocalPackage package path -fetchPackage metadata pair@(packageName'@PackageName{..}, Package{ repo = Remote repo, ..} ) = do +fetchPackage _ (PackageName package, Package { location = Local{..}, .. }) = + echo $ Messages.foundLocalPackage package localPath +fetchPackage metadata pair@(packageName'@PackageName{..}, Package{ location = Remote{..}, .. } ) = do echoDebug $ "Fetching package " <> packageName globalDir <- GlobalCache.getGlobalCacheDir let packageDir = getPackageDir packageName' version @@ -161,11 +161,11 @@ fetchPackage metadata pair@(packageName'@PackageName{..}, Package{ repo = Remote nonCacheableCallback where - quotedName = Messages.surroundQuote packageName + quotedName = surroundQuote packageName git = Text.intercalate " && " [ "git init" - , "git remote add origin " <> repo + , "git remote add origin " <> unRepo repo , "git fetch origin" , "git -c advice.detachedHead=false checkout " <> version ] @@ -186,10 +186,10 @@ getPackageDir PackageName{..} version = Text.unpack packageName <> "/" <> Text.u -- If the package is from a remote git repo, return the folder inside the local cache -- Otherwise return the local folder getLocalCacheDir :: (PackageName, Package) -> FilePath.FilePath -getLocalCacheDir (packageName, Package{ repo = Remote _, ..}) = do +getLocalCacheDir (packageName, Package{ location = Remote{..}, .. }) = do localCacheDir <> "/" <> getPackageDir packageName version -getLocalCacheDir (_, Package{ repo = Local path }) = - Text.unpack path +getLocalCacheDir (_, Package{ location = Local{..}, .. }) = + Text.unpack localPath -- | Returns the name of the cache dir based on the ref, escaped if necessary. diff --git a/src/Spago/GlobalCache.hs b/src/Spago/GlobalCache.hs index 4bcd1ab3a..891180b90 100644 --- a/src/Spago/GlobalCache.hs +++ b/src/Spago/GlobalCache.hs @@ -14,7 +14,7 @@ import qualified System.Environment import qualified System.FilePath as FilePath import qualified Turtle -import Spago.PackageSet (PackageName (..)) +import Spago.PackageSet (PackageName (..), Repo(..)) newtype CommitHash = CommitHash Text @@ -44,13 +44,13 @@ data CacheFlag = SkipCache | NewCache -- URL of the .tar.gz archive on GitHub, otherwise another callback for when it's not globallyCache :: Spago m - => (PackageName, Text, Text) + => (PackageName, Repo, Text) -> FilePath.FilePath -> ReposMetadataV1 -> (FilePath.FilePath -> m ()) -> (m ()) -> m () -globallyCache (packageName, url, ref) downloadDir metadata cacheableCallback notCacheableCallback = do +globallyCache (packageName, Repo url, ref) downloadDir metadata cacheableCallback notCacheableCallback = do echoDebug $ "Running `globallyCache`: " <> tshow packageName <> " " <> url <> " " <> ref case (Text.stripPrefix "https://github.com/" url) >>= (Text.stripSuffix ".git") diff --git a/src/Spago/PackageSet.hs b/src/Spago/PackageSet.hs index 06d375ccc..77e4af738 100644 --- a/src/Spago/PackageSet.hs +++ b/src/Spago/PackageSet.hs @@ -8,6 +8,7 @@ module Spago.PackageSet , pathText , PackageSet(..) , Package (..) + , PackageLocation(..) , PackageName (..) , Repo (..) ) where @@ -36,14 +37,22 @@ newtype PackageName = PackageName { packageName :: Text } -- | A package-set package. -- Matches the packages definition in Package.dhall from package-sets data Package = Package - { dependencies :: ![PackageName] -- ^ list of dependency package names - , repo :: !Repo -- ^ the remote git repository or the local path - , version :: !Text -- ^ version string (also functions as a git ref) + { dependencies :: ![PackageName] -- ^ list of dependency package names + , location :: !PackageLocation -- ^ info about where the package is located } deriving (Eq, Show, Generic) -instance ToJSON Package -instance FromJSON Package + +data PackageLocation + = Remote + { repo :: !Repo -- ^ the remote git repository + , version :: !Text -- ^ version string (also functions as a git ref) + } + | Local + { localPath :: !Text -- ^ local path of the package + } + deriving (Eq, Show, Generic) + data PackageSet = PackageSet { packagesDB :: Map PackageName Package @@ -53,9 +62,7 @@ data PackageSet = PackageSet -- | We consider a "Repo" a "box of source to include in the build" -- This can have different nature: -data Repo - = Local !Text -- ^ A local path - | Remote !Text -- ^ The address of a remote git repository +newtype Repo = Repo { unRepo :: Text } deriving (Eq, Show, Generic) instance ToJSON Repo @@ -66,8 +73,8 @@ instance Dhall.Interpret Repo where where -- We consider a "Remote" anything that `parseURI` thinks is a URI makeRepo repo = case parseURI $ Text.unpack repo of - Just _uri -> Remote repo - Nothing -> Local repo + Just _uri -> Repo repo + Nothing -> error $ "Couldn't parse repo string: " <> Text.unpack repo pathText :: Text @@ -217,8 +224,13 @@ isRemoteFrozen _ = [] freeze :: Spago m => m () freeze = do echo Messages.freezePackageSet - liftIO $ do - Dhall.Freeze.freeze (Just $ Text.unpack pathText) False Dhall.Pretty.ASCII defaultStandardVersion + liftIO $ + Dhall.Freeze.freeze + (Just $ Text.unpack pathText) + Dhall.Freeze.OnlyRemoteImports + Dhall.Freeze.Secure + Dhall.Pretty.ASCII + defaultStandardVersion -- | Freeze the file if any of the remote imports are not frozen diff --git a/src/Spago/Packages.hs b/src/Spago/Packages.hs index ab7cc70e0..36bb9c366 100644 --- a/src/Spago/Packages.hs +++ b/src/Spago/Packages.hs @@ -28,7 +28,7 @@ import qualified Spago.Config as Config import qualified Spago.FetchPackage as Fetch import Spago.GlobalCache (CacheFlag (..)) import qualified Spago.Messages as Messages -import Spago.PackageSet (Package (..), PackageName (..), PackageSet (..), Repo) +import Spago.PackageSet (Package (..), PackageName (..), PackageSet (..), Repo(..)) import qualified Spago.PackageSet as PackageSet import qualified Spago.Purs as Purs import qualified Spago.Templates as Templates @@ -129,9 +129,9 @@ getTransitiveDeps PackageSet{..} deps = do | otherwise = case Map.lookup dep packagesDB of Nothing -> (packagesDB , Set.insert (NotFoundError dep) notFoundErrors, cycleErrors) - Just info@Package{..} -> do + Just packageInfo@Package{..} -> do let (m, notFoundErrors', cycleErrors') = foldMap (go (Set.insert dep seen) notFoundErrors cycleErrors) dependencies - (Map.insert dep info m, notFoundErrors', cycleErrors') + (Map.insert dep packageInfo m, notFoundErrors', cycleErrors') newtype NotFoundError a = NotFoundError a deriving (Eq, Ord) newtype CycleError a = CycleError a deriving (Eq, Ord) @@ -141,7 +141,7 @@ getReverseDeps :: PackageSet -> PackageName -> IO [(PackageName, Package)] getReverseDeps packageSet@PackageSet{..} dep = do List.nub <$> foldMap go (Map.toList packagesDB) where - go pair@(packageName, Package {..}) = + go pair@(packageName, Package{..}) = do case List.find (== dep) dependencies of Nothing -> return mempty Just _ -> do @@ -175,7 +175,7 @@ data JsonFlag = JsonOutputNo | JsonOutputYes data JsonPackageOutput = JsonPackageOutput { json_packageName :: !Text - , json_repo :: !Repo + , json_repo :: !Text , json_version :: !Text } deriving (Eq, Show, Generic) @@ -212,25 +212,37 @@ listPackages packagesFilter jsonFlag = do formatPackageNamesJson :: [(PackageName, Package)] -> [Text] formatPackageNamesJson pkgs = let - asJson (PackageName{..},Package{..}) + asJson (PackageName{..}, Package{ location = PackageSet.Remote{..}, ..}) = JsonPackageOutput { json_packageName = packageName - , json_repo = repo + , json_repo = unRepo repo , json_version = version } + asJson (PackageName{..}, Package { location = PackageSet.Local{..}, ..}) + = JsonPackageOutput + { json_packageName = packageName + , json_repo = localPath + , json_version = "local" + } in map (encodeJsonPackageOutput . asJson) pkgs -- | Format all the package names from the configuration formatPackageNamesText :: [(PackageName, Package)] -> [Text] formatPackageNamesText pkgs = let + showVersion PackageSet.Remote{..} = version + showVersion _ = "local" + + showLocation PackageSet.Remote{ repo = Repo repo } = "Remote " <> surroundQuote repo + showLocation PackageSet.Local{..} = "Local " <> surroundQuote localPath + longestName = maximum $ fmap (Text.length . packageName . fst) pkgs - longestVersion = maximum $ fmap (Text.length . version . snd) pkgs + longestVersion = maximum $ fmap (Text.length . showVersion . location . snd) pkgs - renderPkg (PackageName{..},Package{..}) + renderPkg (PackageName{..}, Package{..}) = leftPad longestName packageName <> " " - <> leftPad longestVersion version <> " " - <> Text.pack (show repo) + <> leftPad longestVersion (showVersion location) <> " " + <> showLocation location in map renderPkg pkgs leftPad :: Int -> Text -> Text @@ -278,7 +290,7 @@ verify maybeLimit cacheFlag maybePackage = do verifyPackage packageSet@PackageSet{..} name = do deps <- getTransitiveDeps packageSet [name] let globs = getGlobs deps - quotedName = Messages.surroundQuote $ packageName name + quotedName = surroundQuote $ packageName name Fetch.fetchPackages maybeLimit cacheFlag deps packagesMinPursVersion echo $ "Verifying package " <> quotedName Purs.compile globs [] diff --git a/src/Spago/Prelude.hs b/src/Spago/Prelude.hs index 80a48fbd2..57e00666f 100644 --- a/src/Spago/Prelude.hs +++ b/src/Spago/Prelude.hs @@ -23,6 +23,7 @@ module Spago.Prelude , FilePath , IOException , ExitCode (..) + , Validation(..) , (<|>) , () , (^..) @@ -80,8 +81,9 @@ import Control.Lens.Combinators (transformMOf) import Control.Monad as X import Control.Monad.Catch as X hiding (try) import Control.Monad.Reader as X -import Data.Aeson as X +import Data.Aeson as X hiding (Result(..)) import Data.Either as X +import Data.Either.Validation (Validation (..)) import Data.Foldable as X import Data.List.NonEmpty (NonEmpty (..)) import Data.Map (Map) @@ -98,9 +100,9 @@ import Prelude as X hiding (FilePath) import Safe (headMay) import System.FilePath (isAbsolute, pathSeparator, ()) import System.IO (hPutStrLn) -import Turtle (ExitCode (..), FilePath, appendonly, mktree, repr, - shell, shellStrict, systemStrictWithErr, testdir, - testfile, chmod, executable) +import Turtle (ExitCode (..), FilePath, appendonly, chmod, + executable, mktree, repr, shell, shellStrict, + systemStrictWithErr, testdir, testfile) import UnliftIO (MonadUnliftIO, withRunInIO) import UnliftIO.Directory (getModificationTime, makeAbsolute) import UnliftIO.Exception (IOException, try) diff --git a/src/Spago/PscPackage.hs b/src/Spago/PscPackage.hs index 171731af4..ff035c313 100644 --- a/src/Spago/PscPackage.hs +++ b/src/Spago/PscPackage.hs @@ -1,8 +1,7 @@ module Spago.PscPackage where -import Prelude +import Spago.Prelude -import Control.Exception (SomeException, try) import qualified Data.Aeson as JSON import Data.Aeson.Encode.Pretty (encodePretty) import qualified Data.Aeson.Encode.Pretty as JSON @@ -12,7 +11,7 @@ import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT -import qualified Dhall.JSON as Dhall.JSON +import qualified Dhall.JSON import GHC.Generics (Generic) import System.Directory (removePathForcibly) import qualified Turtle as T @@ -68,12 +67,12 @@ dhallToJSON inputPath outputPath = do dhall <- T.readTextFile $ T.fromText inputPath - json <- Dhall.JSON.codeToValue Dhall.JSON.NoConversion inputPath dhall + jsonVal <- Dhall.JSON.codeToValue Dhall.JSON.NoConversion Dhall.JSON.ForbidWithinJSON inputPath dhall T.writeTextFile outputPath $ Text.decodeUtf8 $ ByteString.Lazy.toStrict - $ JSON.encodePretty' config json + $ JSON.encodePretty' config jsonVal -- | Generates a local `packages.json` from the current `packages.dhall` diff --git a/src/Spago/Purs.hs b/src/Spago/Purs.hs index 5dc833623..a52ade3e6 100644 --- a/src/Spago/Purs.hs +++ b/src/Spago/Purs.hs @@ -21,7 +21,7 @@ data WithMain = WithMain | WithoutMain compile :: Spago m => [SourcePath] -> [ExtraArg] -> m () compile sourcePaths extraArgs = do let - paths = Text.intercalate " " $ Messages.surroundQuote <$> map unSourcePath sourcePaths + paths = Text.intercalate " " $ surroundQuote <$> map unSourcePath sourcePaths args = Text.intercalate " " $ map unExtraArg extraArgs cmd = "purs compile " <> args <> " " <> paths runWithOutput cmd @@ -30,7 +30,7 @@ compile sourcePaths extraArgs = do repl :: Spago m => [SourcePath] -> [ExtraArg] -> m () repl sourcePaths extraArgs = do - let paths = Text.intercalate " " $ Messages.surroundQuote <$> map unSourcePath sourcePaths + let paths = Text.intercalate " " $ surroundQuote <$> map unSourcePath sourcePaths args = Text.intercalate " " $ map unExtraArg extraArgs cmd = "purs repl " <> paths <> " " <> args @@ -79,7 +79,7 @@ printDocsFormat = \case docs :: Spago m => Maybe DocsFormat -> [SourcePath] -> m () docs format sourcePaths = do let - paths = Text.intercalate " " $ Messages.surroundQuote <$> map unSourcePath sourcePaths + paths = Text.intercalate " " $ surroundQuote <$> map unSourcePath sourcePaths formatStr = printDocsFormat $ fromMaybe Html format cmd = "purs docs " <> paths <> " --format " <> formatStr runWithOutput cmd diff --git a/stack.yaml b/stack.yaml index f14907635..5779304b3 100644 --- a/stack.yaml +++ b/stack.yaml @@ -2,9 +2,13 @@ resolver: lts-12.21 packages: - . extra-deps: -- dhall-1.23.0 -- dhall-json-1.2.8 +- github: dhall-lang/dhall-haskell + commit: 817c833643c37e8fdb71a2efd74bbd7fc895e87d + subdirs: + - dhall + - dhall-json - async-pool-0.9.0.2 +- either-5 - cborg-json-0.2.1.0@sha256:af9137557002ca5308fe80570a9a29398dfb9708423870875223796760689ac3 - versions-3.5.0 - dotgen-0.4.2 @@ -14,5 +18,7 @@ extra-deps: - Win32-2.5.4.1@sha256:e623a1058bd8134ec14d62759f76cac52eee3576711cb2c4981f398f1ec44b85 - Glob-0.10.0 - turtle-1.5.14 +- libyaml-0.1.1.0@sha256:b3fcd8c44622c75e054c2267f3fec39a58a311748000310cbc8257a4683d3f02,2090 +- yaml-0.11.0.0@sha256:8303b3e445295f4fe28ee18efe49ef2667f9f88742ce8049db437c6579be425e,5079 nix: packages: [zlib] From f178f001e448aa6a41a154da0426e601dd6a7689 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Thu, 4 Jul 2019 14:13:31 +0200 Subject: [PATCH 03/16] Fix `spago list-packages --json` format --- src/Spago/PackageSet.hs | 13 +++- src/Spago/Packages.hs | 10 +-- stack.yaml.lock | 135 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 152 insertions(+), 6 deletions(-) create mode 100644 stack.yaml.lock diff --git a/src/Spago/PackageSet.hs b/src/Spago/PackageSet.hs index 77e4af738..8863e5e70 100644 --- a/src/Spago/PackageSet.hs +++ b/src/Spago/PackageSet.hs @@ -54,19 +54,30 @@ data PackageLocation deriving (Eq, Show, Generic) +-- | This instance is to make `spago list-dependencies --json` work +instance ToJSON PackageLocation where + toJSON Remote{..} = object + [ "tag" .= ("Remote" :: Text) + , "contents" .= unRepo repo + ] + toJSON Local{..} = object + [ "tag" .= ("Local" :: Text) + , "contents" .= localPath + ] + data PackageSet = PackageSet { packagesDB :: Map PackageName Package , packagesMinPursVersion :: Maybe Version.SemVer } deriving (Show, Generic) + -- | We consider a "Repo" a "box of source to include in the build" -- This can have different nature: newtype Repo = Repo { unRepo :: Text } deriving (Eq, Show, Generic) instance ToJSON Repo -instance FromJSON Repo instance Dhall.Interpret Repo where autoWith _ = makeRepo <$> Dhall.strictText diff --git a/src/Spago/Packages.hs b/src/Spago/Packages.hs index 36bb9c366..a7b337dec 100644 --- a/src/Spago/Packages.hs +++ b/src/Spago/Packages.hs @@ -175,7 +175,7 @@ data JsonFlag = JsonOutputNo | JsonOutputYes data JsonPackageOutput = JsonPackageOutput { json_packageName :: !Text - , json_repo :: !Text + , json_repo :: !Value , json_version :: !Text } deriving (Eq, Show, Generic) @@ -212,16 +212,16 @@ listPackages packagesFilter jsonFlag = do formatPackageNamesJson :: [(PackageName, Package)] -> [Text] formatPackageNamesJson pkgs = let - asJson (PackageName{..}, Package{ location = PackageSet.Remote{..}, ..}) + asJson (PackageName{..}, Package{ location = loc@PackageSet.Remote{..}, ..}) = JsonPackageOutput { json_packageName = packageName - , json_repo = unRepo repo + , json_repo = toJSON loc , json_version = version } - asJson (PackageName{..}, Package { location = PackageSet.Local{..}, ..}) + asJson (PackageName{..}, Package { location = loc@PackageSet.Local{..}, ..}) = JsonPackageOutput { json_packageName = packageName - , json_repo = localPath + , json_repo = toJSON loc , json_version = "local" } in map (encodeJsonPackageOutput . asJson) pkgs diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 000000000..0d65fb831 --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,135 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: +- completed: + size: 293357 + subdir: dhall + url: https://github.com/dhall-lang/dhall-haskell/archive/817c833643c37e8fdb71a2efd74bbd7fc895e87d.tar.gz + cabal-file: + size: 30387 + sha256: d9715097375de3cbf6180e0fd8766f4483eb554cbea6648b1a719f8d3221acbf + name: dhall + version: 1.24.0 + sha256: bec20683df4f8b1069d6e80efba77726a62e1e18c0b7d5714903d6612e0d51eb + pantry-tree: + size: 8714 + sha256: d8ec0a0769ecf0c10d0ec47a82e55c5f43b2b7e011b9bf3ac09253a7fa3db75a + original: + subdir: dhall + url: https://github.com/dhall-lang/dhall-haskell/archive/817c833643c37e8fdb71a2efd74bbd7fc895e87d.tar.gz +- completed: + size: 293357 + subdir: dhall-json + url: https://github.com/dhall-lang/dhall-haskell/archive/817c833643c37e8fdb71a2efd74bbd7fc895e87d.tar.gz + cabal-file: + size: 5182 + sha256: c9fcb6e5be17cd017ba7364f575abdcc2267d7243a32cdd4ee11dda66d725343 + name: dhall-json + version: 1.3.0 + sha256: bec20683df4f8b1069d6e80efba77726a62e1e18c0b7d5714903d6612e0d51eb + pantry-tree: + size: 1847 + sha256: 5a33b65bbb125f5f0c0ef96d568d8d7f59a1c6ba389e6408c1b154a3aacf35b3 + original: + subdir: dhall-json + url: https://github.com/dhall-lang/dhall-haskell/archive/817c833643c37e8fdb71a2efd74bbd7fc895e87d.tar.gz +- completed: + hackage: async-pool-0.9.0.2@sha256:3aca5861a7b839d02a3f5c52ad6d1ce368631003f68c3d9cb6d711c29e9618db,1599 + pantry-tree: + size: 443 + sha256: 6e97326dc06f9c32fbe7b312e17c427a716a9c2688529ab356de61b0effdb684 + original: + hackage: async-pool-0.9.0.2 +- completed: + hackage: either-5@sha256:3189d6fa583d6b5a2c40120a5b92ade7e72e1f47cf3346f2bf7aac50dda44da4,1388 + pantry-tree: + size: 657 + sha256: 756fc538cac507e2ad2ea1ba1b53743eba4405638ccd4734835191e63e88f3d9 + original: + hackage: either-5 +- completed: + hackage: cborg-json-0.2.1.0@sha256:af9137557002ca5308fe80570a9a29398dfb9708423870875223796760689ac3,1268 + pantry-tree: + size: 274 + sha256: fa0ca2dc2d6cdab48e5ef74ffe248670045fca98339d939e47215a5c3ebe47c0 + original: + hackage: cborg-json-0.2.1.0@sha256:af9137557002ca5308fe80570a9a29398dfb9708423870875223796760689ac3 +- completed: + hackage: versions-3.5.0@sha256:4eacd2eb31d6048b87ce3aa2c5cce98b79ac603cfd0e9c52706fcdb68625eb8d,2550 + pantry-tree: + size: 319 + sha256: 95f204e361a7fb2d943ca580ba60eda9cfb989ca7a9420bf56e7904cbbc9b5a6 + original: + hackage: versions-3.5.0 +- completed: + hackage: dotgen-0.4.2@sha256:309b7cc8a3593a8e48bee7b53020d5f72db156d58edf78a0214f58fbb84b292b,1402 + pantry-tree: + size: 357 + sha256: d03f332855d4d9b02e96931596e358202bd18032c323fb1abd8fe84299d259cd + original: + hackage: dotgen-0.4.2 +- completed: + hackage: megaparsec-7.0.3@sha256:2dd155e03b373ebf082bfea1dcc805a7ec1921b4fb3909c47dee4ab8a3aaf68a,6202 + pantry-tree: + size: 2647 + sha256: 730ec04d25a37b28e19568730d4dda75cd44c7fe9f408316c3117c0a38453763 + original: + hackage: megaparsec-7.0.3 +- completed: + hackage: repline-0.2.1.0@sha256:0f8e92d78e771afb9d41243c2b6ab9609fe02f94e676fae3caed66fa4ce09b18,1187 + pantry-tree: + size: 323 + sha256: f48833fb8a89fc4ede1b254bdfbc8937d82e694eb05bf936bf89293bab691700 + original: + hackage: repline-0.2.1.0 +- completed: + hackage: serialise-0.2.1.0@sha256:8d6051f64c6ebfaf705195dd0b8dfb667617f2e674b290ed2e44985009e4f951,8242 + pantry-tree: + size: 4056 + sha256: 26f4c5d503a78001152b73868bd66c5b3479d9b62bb0134c6557815ced34402a + original: + hackage: serialise-0.2.1.0 +- completed: + hackage: Win32-2.5.4.1@sha256:e623a1058bd8134ec14d62759f76cac52eee3576711cb2c4981f398f1ec44b85,3970 + pantry-tree: + size: 5866 + sha256: 34a2d4724363d2f509aba87672b87a24a5246737421ba904d242b1766c6df080 + original: + hackage: Win32-2.5.4.1@sha256:e623a1058bd8134ec14d62759f76cac52eee3576711cb2c4981f398f1ec44b85 +- completed: + hackage: Glob-0.10.0@sha256:bbccaf21bff9071dcf369f55cc1a07250bdc84c432bdf4277ed53e5e2327cd7d,2947 + pantry-tree: + size: 1432 + sha256: 2b14578b5cf51af20efeaf332a1e1ea0c9c24fe2fcb2afba64f77d9249395844 + original: + hackage: Glob-0.10.0 +- completed: + hackage: turtle-1.5.14@sha256:b70772d4f81bf1f7e4e8245ca02c66c8aab29faf37e34530c4d3eca758bdd546,4908 + pantry-tree: + size: 1114 + sha256: 471c03f64e26b76fde17723a429eb0c17ed3fbd49c3654de8a9c15413c060c4a + original: + hackage: turtle-1.5.14 +- completed: + hackage: libyaml-0.1.1.0@sha256:b3fcd8c44622c75e054c2267f3fec39a58a311748000310cbc8257a4683d3f02,2090 + pantry-tree: + size: 1096 + sha256: 5955a20a686e9cfe6316201085315ec0053ef532788a2d63908457b214dea3ae + original: + hackage: libyaml-0.1.1.0@sha256:b3fcd8c44622c75e054c2267f3fec39a58a311748000310cbc8257a4683d3f02,2090 +- completed: + hackage: yaml-0.11.0.0@sha256:8303b3e445295f4fe28ee18efe49ef2667f9f88742ce8049db437c6579be425e,5079 + pantry-tree: + size: 1989 + sha256: f95eb551d1bebfe405eb7c2901e2eaba9ea17d379fc984bd04d44d4831d3fbca + original: + hackage: yaml-0.11.0.0@sha256:8303b3e445295f4fe28ee18efe49ef2667f9f88742ce8049db437c6579be425e,5079 +snapshots: +- completed: + size: 508406 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/12/21.yaml + sha256: 609dd00c32f59e11bb333b9113d9d2e54269627de1268cbb3cc576af8c7b6237 + original: lts-12.21 From f48dff97e267f50c2cf88e1c3059f55857bfb257 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Thu, 4 Jul 2019 15:25:52 +0200 Subject: [PATCH 04/16] Actually read dependencies from local spago configs --- app/Curator.hs | 12 ++++---- src/Spago/Config.hs | 65 +++++++++++++++++++++++++++-------------- src/Spago/Dhall.hs | 11 +++---- src/Spago/PackageSet.hs | 2 +- src/Spago/Prelude.hs | 6 ++-- 5 files changed, 59 insertions(+), 37 deletions(-) diff --git a/app/Curator.hs b/app/Curator.hs index 1cf0970b3..8d1c9490f 100644 --- a/app/Curator.hs +++ b/app/Curator.hs @@ -196,8 +196,8 @@ spagoUpdater token controlChan fetcherChan = go Nothing go $ Just releaseTagName -fetcher :: Text -> Queue.TBQueue FetcherMessage -> Queue.TQueue MetadataUpdaterMessage -> Queue.TQueue PackageSetsUpdaterMessage -> IO b -fetcher token controlChan metadataChan psChan = forever $ do +fetcher :: MonadIO m => Text -> Queue.TBQueue FetcherMessage -> Queue.TQueue MetadataUpdaterMessage -> Queue.TQueue PackageSetsUpdaterMessage -> m b +fetcher token controlChan metadataChan psChan = liftIO $ forever $ do (atomically $ Queue.readTBQueue controlChan) >>= \case MPackageSetTag tag -> do echo "Downloading and parsing package set.." @@ -216,10 +216,10 @@ fetcher token controlChan metadataChan psChan = forever $ do where -- | Call GitHub to get metadata for a single package - fetchRepoMetadata :: (PackageName, Package) -> IO () + fetchRepoMetadata :: MonadIO m => (PackageName, Package) -> m () fetchRepoMetadata (_, Package{ location = Local{..}, ..}) = pure () fetchRepoMetadata (packageName, Package{ location = Remote{ repo = Repo repoUrl, ..}, ..}) = - Retry.recoverAll (Retry.fullJitterBackoff 50000 <> Retry.limitRetries 25) $ \Retry.RetryStatus{..} -> do + liftIO $ Retry.recoverAll (Retry.fullJitterBackoff 50000 <> Retry.limitRetries 25) $ \Retry.RetryStatus{..} -> do let !(owner:repo:_rest) = Text.split (=='/') $ Text.replace "https://github.com/" "" @@ -250,9 +250,9 @@ fetcher token controlChan metadataChan psChan = forever $ do atomically $ Queue.writeTQueue metadataChan $ MMetadata packageName RepoMetadataV1{..} -- | Tries to read in a PackageSet from GitHub - fetchPackageSet :: Text -> IO PackageSetMap + fetchPackageSet :: MonadIO m => MonadThrow m => Text -> m PackageSetMap fetchPackageSet tag = do - expr <- Dhall.inputExpr ("https://raw.githubusercontent.com/purescript/package-sets/" <> tag <> "/src/packages.dhall") + expr <- liftIO $ Dhall.inputExpr ("https://raw.githubusercontent.com/purescript/package-sets/" <> tag <> "/src/packages.dhall") case expr of Dhall.RecordLit pkgs -> fmap (Map.mapKeys PackageName . Dhall.Map.toMap) $ traverse Spago.Config.parsePackage pkgs diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index fe5b49895..57e875a18 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -49,6 +49,7 @@ type Expr = Dhall.DhallExpr Dhall.Import type ResolvedExpr = Dhall.DhallExpr Dhall.TypeCheck.X + isLocationType :: (Eq s, Eq a) => Dhall.Expr s a -> Bool isLocationType (Dhall.Union kvs) | locationUnionMap == Dhall.Map.toMap kvs = True where @@ -60,18 +61,29 @@ isLocationType (Dhall.Union kvs) | locationUnionMap == Dhall.Map.toMap kvs = Tru ] isLocationType _ = False -parsePackage :: ResolvedExpr -> IO Package + +dependenciesType :: Dhall.Type [PackageName] +dependenciesType = Dhall.list (Dhall.auto :: Dhall.Type PackageName) + +parsePackage :: MonadIO m => MonadThrow m => ResolvedExpr -> m Package parsePackage (Dhall.RecordLit ks) = do let repoType = Dhall.auto :: Dhall.Type PackageSet.Repo - let dependenciesType = Dhall.list (Dhall.auto :: Dhall.Type PackageName) repo <- Dhall.requireTypedKey ks "repo" repoType version <- Dhall.requireTypedKey ks "version" Dhall.strictText dependencies <- Dhall.requireTypedKey ks "dependencies" dependenciesType let location = PackageSet.Remote{..} pure PackageSet.Package{..} -parsePackage (Dhall.App (Dhall.Field union "Local") (Dhall.TextLit (Dhall.Chunks [] localPath))) +parsePackage (Dhall.App (Dhall.Field union "Local") (Dhall.TextLit (Dhall.Chunks [] spagoConfigPath))) | isLocationType union = do - let dependencies = [] + localPath <- case Text.isSuffixOf "/spago.dhall" spagoConfigPath of + True -> pure $ Text.dropEnd 12 spagoConfigPath + False -> error "aaa" -- TODO: nice error about pointing to spago.dhall + rawConfig <- liftIO $ Dhall.readRawExpr spagoConfigPath + dependencies <- case rawConfig of + Nothing -> die Messages.cannotFindConfig -- TODO: maybe different error? + Just (_header, expr) -> do + newExpr <- transformMExpr (pure . filterDependencies . addSourcePaths) expr + liftIO $ Dhall.input dependenciesType (Dhall.pretty newExpr) let location = PackageSet.Local{..} pure PackageSet.Package{..} parsePackage _expr = die "errr" @@ -82,17 +94,16 @@ parseConfig = do withConfigAST $ pure . addSourcePaths expr <- liftIO $ Dhall.inputExpr $ "./" <> pathText case expr of - Dhall.RecordLit ks -> liftIO $ do + Dhall.RecordLit ks -> do packages :: Map PackageName Package <- Dhall.requireKey ks "packages" (\case Dhall.RecordLit pkgs -> fmap (Map.mapKeys PackageSet.PackageName . Dhall.Map.toMap) $ traverse parsePackage pkgs something -> throwM $ Dhall.PackagesIsNotRecord something) - let pkgNamesType = Dhall.list (Dhall.auto :: Dhall.Type PackageName) let sourcesType = Dhall.list (Dhall.auto :: Dhall.Type Purs.SourcePath) name <- Dhall.requireTypedKey ks "name" Dhall.strictText - dependencies <- Dhall.requireTypedKey ks "dependencies" pkgNamesType + dependencies <- Dhall.requireTypedKey ks "dependencies" dependenciesType configSourcePaths <- Dhall.requireTypedKey ks "sources" sourcesType let metadataPackageName = PackageSet.PackageName "metadata" @@ -182,16 +193,26 @@ addRawDeps config newPackages r@(Dhall.RecordLit kvs) seens = Seq.scanl (flip Set.insert) Set.empty xs addRawDeps _ _ other = pure other + addSourcePaths :: Expr -> Expr addSourcePaths (Dhall.RecordLit kvs) | isConfigV1 kvs = Dhall.RecordLit $ Dhall.Map.insert "sources" (Dhall.ListLit Nothing $ fmap Dhall.toTextLit $ Seq.fromList ["src/**/*.purs", "test/**/*.purs"]) kvs - where - isConfigV1 (Set.fromList . Dhall.Map.keys -> configKeySet) = - let configV1Keys = Set.fromList ["name", "dependencies", "packages"] - in configKeySet == configV1Keys addSourcePaths expr = expr +isConfigV1 (Set.fromList . Dhall.Map.keys -> configKeySet) = + let configV1Keys = Set.fromList ["name", "dependencies", "packages"] + in configKeySet == configV1Keys + +isConfigV2 (Set.fromList . Dhall.Map.keys -> configKeySet) = + let configV2Keys = Set.fromList ["name", "dependencies", "packages", "sources"] + in configKeySet == configV2Keys + +filterDependencies :: Expr -> Expr +filterDependencies (Dhall.RecordLit kvs) + | isConfigV2 kvs, Just deps <- Dhall.Map.lookup "dependencies" kvs = deps +filterDependencies expr = expr + -- | Takes a function that manipulates the Dhall AST of the Config, and tries to run it -- on the current config. If it succeeds, it writes back to file the result returned. -- Note: it will pass in the parsed AST, not the resolved one (so e.g. imports will @@ -204,17 +225,17 @@ withConfigAST transform = do Just (header, expr) -> do newExpr <- transformMExpr transform expr liftIO $ Dhall.writeRawExpr pathText (header, newExpr) - where - transformMExpr - :: Spago m - => (Dhall.Expr s Dhall.Import -> m (Dhall.Expr s Dhall.Import)) - -> Dhall.Expr s Dhall.Import - -> m (Dhall.Expr s Dhall.Import) - transformMExpr rules = - transformMOf - Dhall.subExpressions - rules - . Dhall.Core.denote + +transformMExpr + :: MonadIO m + => (Dhall.Expr s Dhall.Import -> m (Dhall.Expr s Dhall.Import)) + -> Dhall.Expr s Dhall.Import + -> m (Dhall.Expr s Dhall.Import) +transformMExpr rules = + transformMOf + Dhall.subExpressions + rules + . Dhall.Core.denote -- | Try to add the `newPackages` to the "dependencies" list in the Config. diff --git a/src/Spago/Dhall.hs b/src/Spago/Dhall.hs index 43c2e034e..f62cd4437 100644 --- a/src/Spago/Dhall.hs +++ b/src/Spago/Dhall.hs @@ -77,11 +77,11 @@ fromTextLit expr = Left $ ExprIsNotTextLit expr -- | Require a key from a Dhall.Map, and run an action on it if found. -- If not found, return the name of the key. requireKey - :: (Typeable b, Pretty b) + :: (Typeable b, Pretty b, MonadIO m, MonadThrow m) => Dhall.Map.Map Text (DhallExpr b) -> Text - -> (DhallExpr b -> IO a) - -> IO a + -> (DhallExpr b -> m a) + -> m a requireKey ks name f = case (Dhall.Map.lookup name ks) of Just v -> f v Nothing -> throwM (RequiredKeyMissing name ks) @@ -89,10 +89,11 @@ requireKey ks name f = case (Dhall.Map.lookup name ks) of -- | Same as `requireKey`, but we give it a Dhall.Type to automagically decode from requireTypedKey - :: Dhall.Map.Map Text (DhallExpr Dhall.TypeCheck.X) + :: (MonadIO m, MonadThrow m) + => Dhall.Map.Map Text (DhallExpr Dhall.TypeCheck.X) -> Text -> Dhall.Type a - -> IO a + -> m a requireTypedKey ks name typ = requireKey ks name $ \expr -> case Dhall.extract typ expr of Success v -> pure v Failure _ -> throwM $ RequiredKeyMissing name ks diff --git a/src/Spago/PackageSet.hs b/src/Spago/PackageSet.hs index 8863e5e70..8b9fb2531 100644 --- a/src/Spago/PackageSet.hs +++ b/src/Spago/PackageSet.hs @@ -54,7 +54,7 @@ data PackageLocation deriving (Eq, Show, Generic) --- | This instance is to make `spago list-dependencies --json` work +-- | This instance is to make `spago list-packages --json` work instance ToJSON PackageLocation where toJSON Remote{..} = object [ "tag" .= ("Remote" :: Text) diff --git a/src/Spago/Prelude.hs b/src/Spago/Prelude.hs index 57e00666f..22cbee891 100644 --- a/src/Spago/Prelude.hs +++ b/src/Spago/Prelude.hs @@ -81,7 +81,7 @@ import Control.Lens.Combinators (transformMOf) import Control.Monad as X import Control.Monad.Catch as X hiding (try) import Control.Monad.Reader as X -import Data.Aeson as X hiding (Result(..)) +import Data.Aeson as X hiding (Result (..)) import Data.Either as X import Data.Either.Validation (Validation (..)) import Data.Foldable as X @@ -93,8 +93,6 @@ import Data.Text (Text) import Data.Text.Prettyprint.Doc (Pretty) import Data.Traversable (for) import Data.Typeable (Proxy (..), Typeable) -import GHC.Conc (atomically, newTVarIO, readTVar, readTVarIO, - writeTVar) import GHC.Generics (Generic) import Prelude as X hiding (FilePath) import Safe (headMay) @@ -107,6 +105,8 @@ import UnliftIO (MonadUnliftIO, withRunInIO) import UnliftIO.Directory (getModificationTime, makeAbsolute) import UnliftIO.Exception (IOException, try) import UnliftIO.Process (callCommand) +import UnliftIO.STM (atomically, newTVarIO, readTVar, readTVarIO, + writeTVar) -- | Generic Error that we throw on program exit. -- We have it so that errors are displayed nicely to the user From cfa28d7142cc45a7415dde7f1faaa68b51e3c3c7 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Fri, 5 Jul 2019 10:33:56 +0200 Subject: [PATCH 05/16] Fix tests --- test/SpagoSpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/SpagoSpec.hs b/test/SpagoSpec.hs index 1c47a7317..bf25f0e43 100644 --- a/test/SpagoSpec.hs +++ b/test/SpagoSpec.hs @@ -89,7 +89,7 @@ spec = around_ setup $ do writeTextFile "psc-package.json" "{ \"name\": \"aaa\", \"depends\": [ \"prelude\" ], \"set\": \"foo\", \"source\": \"bar\" }" spago ["init"] >>= shouldBeSuccess - writeTextFile "spago.dhall" "{- Welcome to a Spago project! You can edit this file as you like. -} { name = \"my-project\" , dependencies = [ \"effect\", \"console\", \"psci-support\", \"a\", \"b\" ] , packages = ./packages.dhall // { a = { version = \"a1\", dependencies = [\"b\"], repo = \"/fake\" }, b = { version = \"b1\", dependencies = [\"a\"], repo = \"/fake\" } } }" + writeTextFile "spago.dhall" "{- Welcome to a Spago project! You can edit this file as you like. -} { name = \"my-project\" , dependencies = [ \"effect\", \"console\", \"psci-support\", \"a\", \"b\" ] , packages = ./packages.dhall // { a = { version = \"a1\", dependencies = [\"b\"], repo = \"https://github.com/fake/fake.git\" }, b = { version = \"b1\", dependencies = [\"a\"], repo = \"https://github.com/fake/fake.git\" } } }" spago ["install"] >>= shouldBeFailureOutput "circular-dependencies.txt" it "Spago should be able to install a package in the set from a commit hash" $ do From b12ea080546ece25479588c339870c934fd640bc Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Fri, 5 Jul 2019 19:55:06 +0200 Subject: [PATCH 06/16] Fix import resolution for local packages --- package.yaml | 4 ++-- src/Spago/Config.hs | 9 ++++++++- src/Spago/Prelude.hs | 5 +++-- src/Spago/PscPackage.hs | 2 +- 4 files changed, 14 insertions(+), 6 deletions(-) diff --git a/package.yaml b/package.yaml index 516fb3309..f6a4df703 100644 --- a/package.yaml +++ b/package.yaml @@ -61,7 +61,7 @@ library: - network-uri - github - versions - - lens + - lens-family-core - safe - fsnotify - Glob @@ -118,7 +118,7 @@ executables: - async-pool - process - github - - lens + - lens-family-core - stm - vector - temporary diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index 57e875a18..4dd2d22f8 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -83,7 +83,14 @@ parsePackage (Dhall.App (Dhall.Field union "Local") (Dhall.TextLit (Dhall.Chunks Nothing -> die Messages.cannotFindConfig -- TODO: maybe different error? Just (_header, expr) -> do newExpr <- transformMExpr (pure . filterDependencies . addSourcePaths) expr - liftIO $ Dhall.input dependenciesType (Dhall.pretty newExpr) + -- Note: we have to use inputWithSettings here because we're about to resolve + -- the raw config from the local project. So if that has any imports they + -- should be relative to the directory of that package + liftIO $ + Dhall.inputWithSettings + (set Dhall.rootDirectory (Text.unpack localPath) Dhall.defaultInputSettings) + dependenciesType + (Dhall.pretty newExpr) let location = PackageSet.Local{..} pure PackageSet.Package{..} parsePackage _expr = die "errr" diff --git a/src/Spago/Prelude.hs b/src/Spago/Prelude.hs index 22cbee891..82bb4de47 100644 --- a/src/Spago/Prelude.hs +++ b/src/Spago/Prelude.hs @@ -27,6 +27,7 @@ module Spago.Prelude , (<|>) , () , (^..) + , set , surroundQuote , transformMOf , testfile @@ -76,8 +77,6 @@ import qualified Turtle as Turtle import qualified UnliftIO.Directory as Directory import Control.Applicative (Alternative, empty, many, (<|>)) -import Control.Lens ((^..)) -import Control.Lens.Combinators (transformMOf) import Control.Monad as X import Control.Monad.Catch as X hiding (try) import Control.Monad.Reader as X @@ -93,7 +92,9 @@ import Data.Text (Text) import Data.Text.Prettyprint.Doc (Pretty) import Data.Traversable (for) import Data.Typeable (Proxy (..), Typeable) +import Dhall.Optics (transformMOf) import GHC.Generics (Generic) +import Lens.Family (set, (^..)) import Prelude as X hiding (FilePath) import Safe (headMay) import System.FilePath (isAbsolute, pathSeparator, ()) diff --git a/src/Spago/PscPackage.hs b/src/Spago/PscPackage.hs index ff035c313..f4affa35d 100644 --- a/src/Spago/PscPackage.hs +++ b/src/Spago/PscPackage.hs @@ -1,6 +1,6 @@ module Spago.PscPackage where -import Spago.Prelude +import Spago.Prelude hiding (set) import qualified Data.Aeson as JSON import Data.Aeson.Encode.Pretty (encodePretty) From ef40ece25f5e01700253f7e6900b929f5cafece9 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Mon, 8 Jul 2019 12:31:16 +0200 Subject: [PATCH 07/16] Fix warnings --- src/Spago/Config.hs | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index 6254dd7f3..78b652108 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -123,8 +123,8 @@ parseConfig = do configSourcePaths <- Dhall.requireTypedKey ks "sources" sourcesType let ensurePublishConfig = do - license <- Dhall.requireTypedKey ks "license" Dhall.strictText - repository <- Dhall.requireTypedKey ks "repository" Dhall.strictText + publishLicense <- Dhall.requireTypedKey ks "license" Dhall.strictText + publishRepository <- Dhall.requireTypedKey ks "repository" Dhall.strictText pure PublishConfig{..} publishConfig <- try ensurePublishConfig @@ -219,13 +219,9 @@ addSourcePaths :: Expr -> Expr addSourcePaths (Dhall.RecordLit kvs) | isConfigV1 kvs = Dhall.RecordLit $ Dhall.Map.insert "sources" (Dhall.ListLit Nothing $ fmap Dhall.toTextLit $ Seq.fromList ["src/**/*.purs", "test/**/*.purs"]) kvs - where - isConfigV1 (Set.fromList . Dhall.Map.keys -> configKeySet) = - let configV1Keys = Set.fromList ["name", "dependencies", "packages"] - in configKeySet == configV1Keys addSourcePaths expr = expr - +isConfigV1, isConfigV2 :: Dhall.Map.Map Text v -> Bool isConfigV1 (Set.fromList . Dhall.Map.keys -> configKeySet) = let configV1Keys = Set.fromList ["name", "dependencies", "packages"] in configKeySet == configV1Keys From d5a0601c673d45b86be9c1b9d94e486e495bc26c Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Mon, 8 Jul 2019 15:50:14 +0200 Subject: [PATCH 08/16] Nice error messages --- src/Spago/Config.hs | 11 +++++------ src/Spago/Messages.hs | 41 +++++++++++++++++++++++++++++++++++++++++ src/Spago/PackageSet.hs | 2 +- 3 files changed, 47 insertions(+), 7 deletions(-) diff --git a/src/Spago/Config.hs b/src/Spago/Config.hs index 78b652108..63c30618c 100644 --- a/src/Spago/Config.hs +++ b/src/Spago/Config.hs @@ -75,9 +75,8 @@ dependenciesType = Dhall.list (Dhall.auto :: Dhall.Type PackageName) parsePackage :: MonadIO m => MonadThrow m => ResolvedExpr -> m Package parsePackage (Dhall.RecordLit ks) = do - let repoType = Dhall.auto :: Dhall.Type PackageSet.Repo - repo <- Dhall.requireTypedKey ks "repo" repoType - version <- Dhall.requireTypedKey ks "version" Dhall.strictText + repo <- Dhall.requireTypedKey ks "repo" (Dhall.auto :: Dhall.Type PackageSet.Repo) + version <- Dhall.requireTypedKey ks "version" Dhall.strictText dependencies <- Dhall.requireTypedKey ks "dependencies" dependenciesType let location = PackageSet.Remote{..} pure PackageSet.Package{..} @@ -85,10 +84,10 @@ parsePackage (Dhall.App (Dhall.Field union "Local") (Dhall.TextLit (Dhall.Chunks | isLocationType union = do localPath <- case Text.isSuffixOf "/spago.dhall" spagoConfigPath of True -> pure $ Text.dropEnd 12 spagoConfigPath - False -> error "aaa" -- TODO: nice error about pointing to spago.dhall + False -> die $ Messages.failedToParseLocalRepo spagoConfigPath rawConfig <- liftIO $ Dhall.readRawExpr spagoConfigPath dependencies <- case rawConfig of - Nothing -> die Messages.cannotFindConfig -- TODO: maybe different error? + Nothing -> die $ Messages.cannotFindConfigLocalPackage spagoConfigPath Just (_header, expr) -> do newExpr <- transformMExpr (pure . filterDependencies . addSourcePaths) expr -- Note: we have to use inputWithSettings here because we're about to resolve @@ -101,7 +100,7 @@ parsePackage (Dhall.App (Dhall.Field union "Local") (Dhall.TextLit (Dhall.Chunks (Dhall.pretty newExpr) let location = PackageSet.Local{..} pure PackageSet.Package{..} -parsePackage _expr = die "errr" +parsePackage expr = die $ Messages.failedToParsePackage $ Dhall.pretty expr -- | Tries to read in a Spago Config diff --git a/src/Spago/Messages.hs b/src/Spago/Messages.hs index dcad0a920..4f6b10dd0 100644 --- a/src/Spago/Messages.hs +++ b/src/Spago/Messages.hs @@ -5,6 +5,47 @@ import Spago.Prelude import qualified Data.Text as Text +failedToParseLocalRepo :: Text -> Text +failedToParseLocalRepo spagoConfigPath = makeMessage + [ "ERROR: your when importing local packages you should point to their `spago.dhall` file." + , "However, the following local package is not: " <> surroundQuote spagoConfigPath + ] + +cannotFindConfigLocalPackage :: Text -> Text +cannotFindConfigLocalPackage spagoConfigPath + = "ERROR: it was not possible to find a `spago.dhall` file at the following location: " + <> surroundQuote spagoConfigPath + +failedToParsePackage :: Text -> Text +failedToParsePackage expr = makeMessage + [ "ERROR: could not read a Package configuration." + , "For remote packages, this is the expected type of the Package configuration:" + , "" + , "{ repo : Text, version : Text, dependencies : List Text }" + , "" + , "For local packages, this is how you should import them:" + , "" + , "./path/to/some/local/package/spago.dhall as Location" + , "" + , "..but your package declaration didn't match any of them, and was the following expression instead:" + , "" + , expr + ] + +failedToParseRepoString :: Text -> Text +failedToParseRepoString repo = makeMessage + [ "ERROR: was not able to parse the address to the remote repo: " <> surroundQuote repo + , "" + , "This might be for one of the following reasons:" + , "" + , "- you're including a local path as a 'repo address', but that's not supported anymore, and you should switch to the new syntax for importing local packages, e.g.:" + , "" + , " let overrides = { some-package = ./some/local/path/spago.dhall as Location }" + , "" + , "- you're trying to use a URL which doesn't conform to RFC 3986, e.g. in the form of `git@foo.com:bar/baz.git`." + , " The above example can be rewritten in a valid form as \"ssh://git@foo.com/bar/baz.git\"" + ] + cannotFindConfig :: Text cannotFindConfig = makeMessage [ "There's no " <> surroundQuote "spago.dhall" <> " in your current location." diff --git a/src/Spago/PackageSet.hs b/src/Spago/PackageSet.hs index bbe63f2e0..9da26bd72 100644 --- a/src/Spago/PackageSet.hs +++ b/src/Spago/PackageSet.hs @@ -85,7 +85,7 @@ instance Dhall.Interpret Repo where -- We consider a "Remote" anything that `parseURI` thinks is a URI makeRepo repo = case parseURI $ Text.unpack repo of Just _uri -> Repo repo - Nothing -> error $ "Couldn't parse repo string: " <> Text.unpack repo + Nothing -> error $ Text.unpack $ Messages.failedToParseRepoString repo pathText :: Text From 4c42deacd56ac84b0267e1a298d7f4323ae518f3 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Mon, 8 Jul 2019 18:30:48 +0200 Subject: [PATCH 09/16] Update README for the new local packages and add a dedicated monorepo section --- README.md | 153 +++++++++++++++++++++++++++--------------------------- 1 file changed, 76 insertions(+), 77 deletions(-) diff --git a/README.md b/README.md index e7ed5658d..153c88b2b 100644 --- a/README.md +++ b/README.md @@ -268,8 +268,8 @@ This is just a thin layer above the PureScript compiler command `purs compile`. The build will produce very many JavaScript files in the `output/` folder. These are CommonJS modules, and you can just `require()` them e.g. on Node. -It's also possible to include custom source paths when building (`src` and `test` -are always included): +It's also possible to include custom source paths when building (the ones declared in your +`sources` config are always included): ```bash $ spago build --path 'another_source/**/*.purs' @@ -391,13 +391,14 @@ Now if I want to test this version in my current project, how can I tell `spago` We have a `overrides` record in `packages.dhall` just for that! -In this case we override the `repo` key with the local path of the package. +In this case we override the package with its local copy, which must have a `spago.dhall`. +(it should be enough to do `spago init` to have the Bower configuration imported) + It might look like this: ```haskell let overrides = - { simple-json = - upstream.simple-json // { repo = "../purescript-simple-json" } + { simple-json = ../purescript-simple-json/spago.dhall as Location } ``` @@ -408,26 +409,14 @@ $ spago list-packages ... signal v10.1.0 Remote "https://github.com/bodil/purescript-signal.git" sijidou v0.1.0 Remote "https://github.com/justinwoo/purescript-sijidou.git" -simple-json v4.4.0 Local "../purescript-simple-json" +simple-json local Local "./../purescript-simple-json" simple-json-generics v0.1.0 Remote "https://github.com/justinwoo/purescript-simple-json-generics.git" smolder v11.0.1 Remote "https://github.com/bodil/purescript-smolder.git" ... ``` And since local packages are just included in the build, if we add it to the `dependencies` -in `spago.dhall` and then do `spago install`, it will not be downloaded: - -``` -$ spago install -Installing 42 dependencies. -... -Installing "refs" -Installing "identity" -Skipping package "simple-json", using local path: "../purescript-simple-json" -Installing "control" -Installing "enums" -... -``` +in `spago.dhall` and then do `spago install`, it will not be downloaded. ### Override a package in the package set with a remote one @@ -482,22 +471,13 @@ let additions = The `mkPackage` function should be already included in your `packages.dhall`, and it will expect as input a list of dependencies, the location of the package, and the tag you wish to use. -Of course this works also in the case of adding local packages. In this case you won't -care about the value of the "version" (since it won't be used), so you can put arbitrary -values in there. - -And of course if the package you're adding has a `spago.dhall` file you can just import it -and pull the dependencies from there, instead of typing down the list of dependencies! +Of course this works also in the case of adding local packages, which work exactly as the `overrides`: Example: ```haskell let additions = - { foobar = - mkPackage - (../foobar/spago.dhall).dependencies - "../foobar" - "local-fix-whatever" + { foobar = ../foobar/spago.dhall as Location } ``` @@ -556,77 +536,107 @@ let upstream = ``` -### Separate `devDependencies` or test dependencies +### Monorepo -`spago` aims to support monorepos. This means that supporting "split" dependencies between tests -and apps or just for dev can be handled as a "monorepo situation". +Spago aims to support ["monorepos"][luu-monorepo], allowing you to split a blob of code +into different "compilation units" that might have different dependencies, deliverables, etc. -So for example if you wish to separate dependencies for some `app` and `lib` you're working on, -you can handle it by having multiple `spago.dhall` config files for the lib and the executable. +A typical monorepo setup in spago consists of: +- some "libraries" (i.e. packages that other packages will depend on), each having their own `spago.dhall` +- some "apps" (i.e. packages that no one depends on), each having their own `spago.dhall` +- a single `packages.dhall` , that includes all the "libraries" as local packages, and that + all `spago.dhall` files refer to - this is so that all packages share the same package set. -E.g. let's say you have the following tree: +So for example if you have `lib1`, `lib2` and `app1`, you might have the following file tree: ``` . -├── app +├── app1 │ ├── spago.dhall │ ├── src │ │ └── Main.purs │ └── test │ └── Main.purs -├── lib +├── lib1 │ ├── spago.dhall -│ ├── src -│ │ └── Main.purs -│ └── test +│ └── src +│ └── Main.purs +├── lib2 +│ ├── spago.dhall +│ └── src │ └── Main.purs └── packages.dhall ``` Then: -- the top level `packages.dhall` is standard and contains the link to the upstream and project-level overrides, etc -- `lib/spago.dhall` might look something like this: +- the top level `packages.dhall` might look like this: -```hs +```dhall +let upstream = https://raw.githubusercontent.com/purescript/package-sets/psc-0.13.0-20190626/src/packages.dhall sha256:9905f07c9c3bd62fb3205e2108515811a89d55cff24f4341652f61ddacfcf148 + +let overrides = + { lib1 = ./lib1/spago.dhall as Location + , lib2 = ./lib2/spago.dhall as Location + } + +in upstream // overrides +``` + +- `lib1/spago.dhall` might look something like this: + +```dhall { name = - "my-lib" + "lib1" , dependencies = [ "effect" , "console" - , "psci-support" , "prelude" ] +, sources = + [ "src/**/*.purs" ] , packages = ../packages.dhall -- Note: this refers to the top-level packages file } ``` -- `app/spago.dhall` might look something like this: +- assuming `lib1` depends on `lib2`, `lib2/spago.dhall` might look something like this: + +```dhall +{ name = + "lib2" +, dependencies = + [ "effect" + , "console" + , "prelude" + , "lib1" -- Note the dependency here + ] +, sources = + [ "src/**/*.purs" ] +, packages = + ../packages.dhall +} +``` + +- and then `app1/spago.dhall` might look something like this: ```hs { name = - "my-app" + "app1" , dependencies = -- Note: the app does not include all the dependencies that the lib included [ "prelude" - , "simple-json" -- Note: this dep was not used by the library, only the executable uses it - , "my-lib" -- Note: we add the library as dependency + , "simple-json" -- Note: this dep was not used by the library, only the app uses it + , "lib2" -- Note: we add `lib2` as dependency ] , packages = - -- We refer to the top-level packages file here too, so deps stay in sync - -- and we also add the library as a local package - (../packages.dhall) // - { my-lib = - { repo = "../my-lib" - , version = "" - , dependencies = (../my-lib/spago.dhall).dependencies - } - } + -- We also refer to the top-level packages file here, so deps stay in sync for all packages + ../packages.dhall } ``` -With this setup you're able to decouple dependencies in the library and in the executables. - +Note that you can also handle as a "monorepo" a simpler situation where you want to "split" +dependencies, so e.g. if you want to not include your test dependencies in your app's +dependencies, you can have a "test" project depend on the "app" project. ### Bundle a project into a single JS file @@ -778,9 +788,11 @@ do done ``` -### Know what `purs` commands are run under the hood +### Know which `purs` commands are run under the hood -The `-v` flag will print out all the `purs` commands that `spago` invokes during its operations. +The `-v` flag will print out all the `purs` commands that `spago` invokes during its operations, +plus a lot of diagnostic info, so you might want to use it to troubleshoot weird behaviours +and/or crashes. ### Ignore or update the global cache @@ -925,20 +937,6 @@ global cache kind of useless. So we are just caching all of that info for everyo ## Troubleshooting -#### I added a git repo URL to my overrides, but `spago` thinks it's a local path 🤔 - -This might happen if you copy the "git" URL from a GitHub repo and try adding it as a repo URL -in your package set. - -However, `spago` requires URLs to conform to [RFC 3986](https://tools.ietf.org/html/rfc3986), -which something like `git@foo.com:bar/baz.git` doesn't conform to. - -To have the above repo location accepted you should rewrite it like this: -``` -ssh://git@foo.com/bar/baz.git -``` - - #### My `install` command is failing with some errors about "too many open files" This might happen because the limit of "open files per process" is too low in your OS - as @@ -997,6 +995,7 @@ See [this document](./INTERNALS.md) [purescript]: https://github.com/purescript/purescript [psc-package]: https://github.com/purescript/psc-package [contributing]: CONTRIBUTING.md +[luu-monorepo]: https://danluu.com/monorepo/ [package-sets]: https://github.com/purescript/package-sets [travis-spago]: https://travis-ci.com/spacchetti/spago [spago-issues]: https://github.com/spacchetti/spago/issues From 801d59d2f60f9f53056589e1df35540fa0f524b8 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Wed, 10 Jul 2019 18:19:39 +0300 Subject: [PATCH 10/16] Fix import --- src/Spago/Purs.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Spago/Purs.hs b/src/Spago/Purs.hs index 88c605623..9ddbae453 100644 --- a/src/Spago/Purs.hs +++ b/src/Spago/Purs.hs @@ -41,7 +41,7 @@ compile sourcePaths extraArgs = do Right _ -> pure "psa" Left _ -> pure "purs" - echoDebug $ "Compiling with " <> Messages.surroundQuote purs + echoDebug $ "Compiling with " <> surroundQuote purs let paths = Text.intercalate " " $ surroundQuote <$> map unSourcePath sourcePaths From cf9d955a5a487089690ed396c05ab72e36f51193 Mon Sep 17 00:00:00 2001 From: Elliot Davies Date: Wed, 10 Jul 2019 16:29:20 +0100 Subject: [PATCH 11/16] Fix local dependency tests (#311) * Fix local dependency tests * Extend test to include check for local transitive dependencies --- test/BumpVersionSpec.hs | 2 +- test/SpagoSpec.hs | 38 ++++++++++++++++++++++++++------------ 2 files changed, 27 insertions(+), 13 deletions(-) diff --git a/test/BumpVersionSpec.hs b/test/BumpVersionSpec.hs index f2e073bc8..569d90951 100644 --- a/test/BumpVersionSpec.hs +++ b/test/BumpVersionSpec.hs @@ -119,6 +119,6 @@ spec = around_ setup $ do mkdir "purescript-tortellini" withCwd "purescript-tortellini" $ spago ["init"] >>= shouldBeSuccess - setOverrides "{ tortellini = upstream.tortellini // { repo = \"./purescript-tortellini\" } }" + setOverrides "{ tortellini = ./purescript-tortellini/spago.dhall as Location }" spago ["bump-version", "minor"] >>= shouldBeFailureInfix "Unable to create Bower version for local repo: ./purescript-tortellini" diff --git a/test/SpagoSpec.hs b/test/SpagoSpec.hs index dd87ef63f..92558fef5 100644 --- a/test/SpagoSpec.hs +++ b/test/SpagoSpec.hs @@ -1,11 +1,10 @@ module SpagoSpec (spec) where import Control.Concurrent (threadDelay) -import Data.Foldable (for_) import Prelude hiding (FilePath) import qualified System.IO.Temp as Temp import Test.Hspec (Spec, around_, describe, it, shouldBe) -import Turtle (cd, cp, decodeString, fromText, mkdir, mktree, mv, readTextFile, +import Turtle (cd, cp, decodeString, mkdir, mktree, mv, readTextFile, rm, testdir, writeTextFile) import Utils (checkFixture, readFixture, runFor, shouldBeFailure, shouldBeFailureOutput, shouldBeSuccess, shouldBeSuccessOutput, @@ -123,22 +122,37 @@ spec = around_ setup $ do it "Spago should install successfully when there are local dependencies sharing the same packages.dhall" $ do - -- Create local 'lib-a' and 'lib-b' packages - for_ ["lib-a", "lib-b"] $ \name -> do - mkdir $ fromText name - cd $ fromText name - spago ["init"] >>= shouldBeSuccess - rm "spago.dhall" - writeTextFile "spago.dhall" $ "{ name = \"" <> name <> "\", dependencies = ./spago-deps.dhall, packages = ../packages.dhall }" - writeTextFile "spago-deps.dhall" "[\"console\", \"effect\", \"prelude\"]" - cd ".." + -- Create local 'lib-a' package that depends on lib-c + mkdir "lib-a" + cd "lib-a" + spago ["init"] >>= shouldBeSuccess + rm "spago.dhall" + writeTextFile "spago.dhall" $ "{ name = \"lib-a\", dependencies = [\"console\", \"effect\", \"prelude\", \"lib-c\"], packages = ../packages.dhall }" + cd ".." + + -- Create local 'lib-b' package that has its dependencies in a separate file + mkdir "lib-b" + cd "lib-b" + spago ["init"] >>= shouldBeSuccess + rm "spago.dhall" + writeTextFile "spago.dhall" $ "{ name = \"lib-b\", dependencies = ./spago-deps.dhall, packages = ../packages.dhall }" + writeTextFile "spago-deps.dhall" "[\"console\", \"effect\", \"prelude\"]" + cd ".." + + -- Create local 'lib-c' package + mkdir "lib-c" + cd "lib-c" + spago ["init"] >>= shouldBeSuccess + rm "spago.dhall" + writeTextFile "spago.dhall" $ "{ name = \"lib-c\", dependencies = [\"console\", \"effect\", \"prelude\"], packages = ../packages.dhall }" + cd ".." -- Create 'app' package that depends on 'lib-a' and 'lib-b' spago ["init"] >>= shouldBeSuccess rm "spago.dhall" writeTextFile "spago.dhall" "{ name = \"app\", dependencies = [\"console\", \"effect\", \"prelude\", \"lib-a\", \"lib-b\"], packages = ./packages.dhall }" packageDhall <- readTextFile "packages.dhall" - writeTextFile "packages.dhall" $ packageDhall <> " // { lib-a = mkPackage ./lib-a/spago-deps.dhall \"./lib-a\" \"v1.0.0\", lib-b = mkPackage ./lib-b/spago-deps.dhall \"./lib-b\" \"v1.0.0\" }" + writeTextFile "packages.dhall" $ packageDhall <> " // { lib-a = ./lib-a/spago.dhall as Location, lib-b = ./lib-b/spago.dhall as Location, lib-c = ./lib-c/spago.dhall as Location }" spago ["install"] >>= shouldBeSuccess From 3bd56834197956f8d8a32676faf49e8fa65ad968 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Mon, 22 Jul 2019 11:46:01 +0300 Subject: [PATCH 12/16] Fix import list --- src/Spago/Bower.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Spago/Bower.hs b/src/Spago/Bower.hs index ca95ef207..d4b53fea5 100644 --- a/src/Spago/Bower.hs +++ b/src/Spago/Bower.hs @@ -25,7 +25,7 @@ import qualified Spago.Config as Config import Spago.DryRun (DryRun (..)) import qualified Spago.Git as Git import qualified Spago.Packages as Packages -import Spago.PackageSet (PackageName (..), Package (..), PackageLocation(..)) +import Spago.PackageSet (PackageName (..), Package (..), PackageLocation(..), Repo(..)) import qualified Spago.Templates as Templates From 93b2b48cf49771acacbd16f5df956da56f04e657 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Thu, 25 Jul 2019 21:28:32 +0300 Subject: [PATCH 13/16] Upgrade to latest package set --- templates/packages.dhall | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/templates/packages.dhall b/templates/packages.dhall index 5e1c6f3cc..49b6ec58b 100644 --- a/templates/packages.dhall +++ b/templates/packages.dhall @@ -119,7 +119,7 @@ let additions = let upstream = - https://github.com/purescript/package-sets/releases/download/psc-0.13.2-20190715/packages.dhall sha256:906af79ba3aec7f429b107fd8d12e8a29426db8229d228c6f992b58151e2308e + https://github.com/purescript/package-sets/releases/download/psc-0.13.2-20190725/packages.dhall sha256:60cc03d2c3a99a0e5eeebb16a22aac219fa76fe6a1686e8c2bd7a11872527ea3 let overrides = {=} From 2b4e1284169e09e4650a6922a5415d97c001129c Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Thu, 25 Jul 2019 21:28:49 +0300 Subject: [PATCH 14/16] Upgrade to latest dhall-haskell commit --- stack.yaml | 4 +++- stack.yaml.lock | 46 ++++++++++++++++++++++++++++++---------------- 2 files changed, 33 insertions(+), 17 deletions(-) diff --git a/stack.yaml b/stack.yaml index 5779304b3..4fba1b6f7 100644 --- a/stack.yaml +++ b/stack.yaml @@ -3,7 +3,7 @@ packages: - . extra-deps: - github: dhall-lang/dhall-haskell - commit: 817c833643c37e8fdb71a2efd74bbd7fc895e87d + commit: 354346be91ca62d64a1d68dcf7897e5a30f8646c subdirs: - dhall - dhall-json @@ -20,5 +20,7 @@ extra-deps: - turtle-1.5.14 - libyaml-0.1.1.0@sha256:b3fcd8c44622c75e054c2267f3fec39a58a311748000310cbc8257a4683d3f02,2090 - yaml-0.11.0.0@sha256:8303b3e445295f4fe28ee18efe49ef2667f9f88742ce8049db437c6579be425e,5079 +- th-lift-0.8.0.1@sha256:cceb81b12c0580e02a7a3898b6d60cca5e1be080741f69ddde4f12210d8ba7ca,1960 +- th-lift-instances-0.1.13@sha256:2852e468511805cb25d9e3923c9e91647d008ab4a764ec0921e5e40ff8a8e874,2625 nix: packages: [zlib] diff --git a/stack.yaml.lock b/stack.yaml.lock index 13cab40bd..735adcf88 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -5,37 +5,37 @@ packages: - completed: - size: 293357 + size: 300776 subdir: dhall - url: https://github.com/dhall-lang/dhall-haskell/archive/817c833643c37e8fdb71a2efd74bbd7fc895e87d.tar.gz + url: https://github.com/dhall-lang/dhall-haskell/archive/354346be91ca62d64a1d68dcf7897e5a30f8646c.tar.gz cabal-file: - size: 30387 - sha256: d9715097375de3cbf6180e0fd8766f4483eb554cbea6648b1a719f8d3221acbf + size: 40233 + sha256: a322ba6dea998b227e3edefca0c841081a42e9f7924e5dbf711c691f60a35cbc name: dhall version: 1.24.0 - sha256: bec20683df4f8b1069d6e80efba77726a62e1e18c0b7d5714903d6612e0d51eb + sha256: 0b46c36486429c7a7466b3d7fa7c9c9a3186ab003759de7eb2b85199323a9f9a pantry-tree: - size: 8714 - sha256: d8ec0a0769ecf0c10d0ec47a82e55c5f43b2b7e011b9bf3ac09253a7fa3db75a + size: 8842 + sha256: 584a497c36f5e77def27eed68aec6f2a249ce28b16b52c3d412cd70e76fa8122 original: subdir: dhall - url: https://github.com/dhall-lang/dhall-haskell/archive/817c833643c37e8fdb71a2efd74bbd7fc895e87d.tar.gz + url: https://github.com/dhall-lang/dhall-haskell/archive/354346be91ca62d64a1d68dcf7897e5a30f8646c.tar.gz - completed: - size: 293357 + size: 300776 subdir: dhall-json - url: https://github.com/dhall-lang/dhall-haskell/archive/817c833643c37e8fdb71a2efd74bbd7fc895e87d.tar.gz + url: https://github.com/dhall-lang/dhall-haskell/archive/354346be91ca62d64a1d68dcf7897e5a30f8646c.tar.gz cabal-file: - size: 5182 - sha256: c9fcb6e5be17cd017ba7364f575abdcc2267d7243a32cdd4ee11dda66d725343 + size: 5634 + sha256: f22a2afb411cdaa44a2db338fc34bed92c384f48b532d867500f3176f70e0c87 name: dhall-json version: 1.3.0 - sha256: bec20683df4f8b1069d6e80efba77726a62e1e18c0b7d5714903d6612e0d51eb + sha256: 0b46c36486429c7a7466b3d7fa7c9c9a3186ab003759de7eb2b85199323a9f9a pantry-tree: - size: 1847 - sha256: 5a33b65bbb125f5f0c0ef96d568d8d7f59a1c6ba389e6408c1b154a3aacf35b3 + size: 2868 + sha256: 489ecc094d28f092559914ac6ac4fb022bae483fefcfe86878850e7af6416046 original: subdir: dhall-json - url: https://github.com/dhall-lang/dhall-haskell/archive/817c833643c37e8fdb71a2efd74bbd7fc895e87d.tar.gz + url: https://github.com/dhall-lang/dhall-haskell/archive/354346be91ca62d64a1d68dcf7897e5a30f8646c.tar.gz - completed: hackage: async-pool-0.9.0.2@sha256:3aca5861a7b839d02a3f5c52ad6d1ce368631003f68c3d9cb6d711c29e9618db,1599 pantry-tree: @@ -127,6 +127,20 @@ packages: sha256: f95eb551d1bebfe405eb7c2901e2eaba9ea17d379fc984bd04d44d4831d3fbca original: hackage: yaml-0.11.0.0@sha256:8303b3e445295f4fe28ee18efe49ef2667f9f88742ce8049db437c6579be425e,5079 +- completed: + hackage: th-lift-0.8.0.1@sha256:cceb81b12c0580e02a7a3898b6d60cca5e1be080741f69ddde4f12210d8ba7ca,1960 + pantry-tree: + size: 461 + sha256: 7ed900048c8722069edb6063023d89343f056ca305be598f51f166bd389621df + original: + hackage: th-lift-0.8.0.1@sha256:cceb81b12c0580e02a7a3898b6d60cca5e1be080741f69ddde4f12210d8ba7ca,1960 +- completed: + hackage: th-lift-instances-0.1.13@sha256:2852e468511805cb25d9e3923c9e91647d008ab4a764ec0921e5e40ff8a8e874,2625 + pantry-tree: + size: 526 + sha256: 04bfabd50736570361f5f54d29be6d26b21459c2ccabb10abe40e79d6b763f30 + original: + hackage: th-lift-instances-0.1.13@sha256:2852e468511805cb25d9e3923c9e91647d008ab4a764ec0921e5e40ff8a8e874,2625 snapshots: - completed: size: 508406 From 408087fb8a1d89ffa6290f756ac0b604bcd7026d Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Sat, 27 Jul 2019 20:45:56 +0300 Subject: [PATCH 15/16] Remove dependency on lens and use existing Bower machinery for the Bower migration --- src/Spago/BowerMigration.hs | 52 +++++++++++++-------------------- src/Spago/Messages.hs | 4 --- src/Spago/Packages.hs | 57 +++++++++++++++++++------------------ src/Spago/PscPackage.hs | 2 +- stack.yaml.lock | 7 +++++ 5 files changed, 58 insertions(+), 64 deletions(-) diff --git a/src/Spago/BowerMigration.hs b/src/Spago/BowerMigration.hs index 4f4c11f92..4be666a94 100644 --- a/src/Spago/BowerMigration.hs +++ b/src/Spago/BowerMigration.hs @@ -1,41 +1,30 @@ module Spago.BowerMigration where -import Spago.Prelude hiding (Success) +import Spago.Prelude hiding (Success) -import Control.Lens ((^@..)) -import qualified Data.Aeson as A -import Data.Aeson.Lens -import Data.Bifunctor (bimap) -import qualified Data.ByteString.Lazy as B +import qualified Data.Aeson as A +import Data.Bifunctor (bimap) +import qualified Data.ByteString.Lazy as B import Data.Either.Validation -import qualified Data.SemVer as SemVer -import qualified Data.Text.Encoding as Text -import qualified Spago.Messages as Messages +import qualified Data.SemVer as SemVer +import qualified Data.Text.Encoding as Text +import qualified Spago.Messages as Messages +import Web.Bower.PackageMeta (PackageMeta (..)) +import qualified Web.Bower.PackageMeta as Bower data Dependency = Dependency - { name :: Text + { name :: Text , rangeText :: Text - , range :: SemVer.SemVerRange + , range :: SemVer.SemVerRange } deriving (Show) -data RawDependency = RawDependency - { name :: Text - , range :: Text - } deriving (Show) - -parseRange :: RawDependency -> Validation [RawDependency] Dependency -parseRange raw@RawDependency{..} - = bimap (const $ [raw]) (Dependency name range) +parseRange :: (Bower.PackageName, Bower.VersionRange) -> Validation [(Text, Text)] Dependency +parseRange (name', Bower.VersionRange range) + = bimap (const $ [(name, range)]) (Dependency name range) $ eitherToValidation $ SemVer.parseSemVerRange range - -rawDeps :: A.Value -> [RawDependency] -rawDeps input - = foldMap (fmap (uncurry RawDependency) . get) ["dependencies", "devDependencies"] where - get x = input ^@.. key x - . members - . _String + name = Bower.runPackageName name' pathText :: Text pathText = "bower.json" @@ -48,14 +37,13 @@ path = pathFromText pathText ensureBowerFile :: Spago m => m [Dependency] ensureBowerFile = do exists <- testfile path - unless exists $ do - die $ Messages.cannotFindBowerFile + unless exists $ die "Cannot find bower.json" file <- B.fromStrict . Text.encodeUtf8 <$> readTextFile path - case rawDeps <$> A.eitherDecode file of - Left err -> die $ Messages.failedToParseFile pathText err - Right raw -> case traverse parseRange raw of + case A.eitherDecode file of + Left err -> die $ Messages.failedToParseFile pathText err + Right PackageMeta{..} -> case traverse parseRange (bowerDependencies <> bowerDevDependencies) of Failure x -> let - names = (\RawDependency{..} -> name) <$> x + names :: [Text] = fst <$> x message = Messages.makeMessage $ "Could not parse range for package(s):" : names in die message Success x -> pure x diff --git a/src/Spago/Messages.hs b/src/Spago/Messages.hs index d506f90bb..e80e05a47 100644 --- a/src/Spago/Messages.hs +++ b/src/Spago/Messages.hs @@ -54,10 +54,6 @@ cannotFindConfig = makeMessage , "otherwise you might want to run `spago init` to initialize a new project." ] -cannotFindBowerFile :: Text -cannotFindBowerFile - = "There's no " <> surroundQuote "bower.json" <> " in your current location." - cannotFindPackages :: Text cannotFindPackages = makeMessage [ "There's no " <> surroundQuote "packages.dhall" <> " in your current location." diff --git a/src/Spago/Packages.hs b/src/Spago/Packages.hs index c2b125f6c..e9a1fb0a5 100644 --- a/src/Spago/Packages.hs +++ b/src/Spago/Packages.hs @@ -18,25 +18,26 @@ module Spago.Packages import Spago.Prelude -import Data.Aeson as Aeson -import qualified Data.List as List -import qualified Data.Map as Map -import qualified Data.Set as Set -import qualified Data.SemVer as SemVer -import qualified Data.Text as Text -import qualified Data.Text.Lazy as LT -import qualified Data.Text.Lazy.Encoding as LT - -import Spago.BowerMigration as Bower -import Spago.Config (Config (..)) -import qualified Spago.Config as Config -import qualified Spago.FetchPackage as Fetch -import Spago.GlobalCache (CacheFlag (..)) -import qualified Spago.Messages as Messages -import Spago.PackageSet (Package (..), PackageName (..), PackageSet (..), Repo(..)) -import qualified Spago.PackageSet as PackageSet -import qualified Spago.Purs as Purs -import qualified Spago.Templates as Templates +import Data.Aeson as Aeson +import qualified Data.List as List +import qualified Data.Map as Map +import qualified Data.SemVer as SemVer +import qualified Data.Set as Set +import qualified Data.Text as Text +import qualified Data.Text.Lazy as LT +import qualified Data.Text.Lazy.Encoding as LT + +import Spago.BowerMigration as Bower +import Spago.Config (Config (..)) +import qualified Spago.Config as Config +import qualified Spago.FetchPackage as Fetch +import Spago.GlobalCache (CacheFlag (..)) +import qualified Spago.Messages as Messages +import Spago.PackageSet (Package (..), PackageLocation (..), PackageName (..), + PackageSet (..), Repo (..)) +import qualified Spago.PackageSet as PackageSet +import qualified Spago.Purs as Purs +import qualified Spago.Templates as Templates -- | Init a new Spago project: @@ -95,7 +96,7 @@ getGlobs deps depsOnly configSourcePaths -> Purs.SourcePath $ Text.pack $ Fetch.getLocalCacheDir pair <> "/src/**/*.purs") deps <> case depsOnly of - DepsOnly -> [] + DepsOnly -> [] AllSources -> configSourcePaths @@ -232,7 +233,7 @@ listPackages packagesFilter jsonFlag = do where formatPackageNames = case jsonFlag of JsonOutputYes -> formatPackageNamesJson - JsonOutputNo -> formatPackageNamesText + JsonOutputNo -> formatPackageNamesText -- | Format all the packages from the config in JSON formatPackageNamesJson :: [(PackageName, Package)] -> [Text] @@ -257,10 +258,10 @@ listPackages packagesFilter jsonFlag = do formatPackageNamesText pkgs = let showVersion PackageSet.Remote{..} = version - showVersion _ = "local" + showVersion _ = "local" showLocation PackageSet.Remote{ repo = Repo repo } = "Remote " <> surroundQuote repo - showLocation PackageSet.Local{..} = "Local " <> surroundQuote localPath + showLocation PackageSet.Local{..} = "Local " <> surroundQuote localPath longestName = maximum $ fmap (Text.length . packageName . fst) pkgs longestVersion = maximum $ fmap (Text.length . showVersion . location . snd) pkgs @@ -309,21 +310,23 @@ verifyBower = do traverse_ echo $ "Packages:" : (display <$> success) where check :: Map PackageName Package -> Bower.Dependency -> BowerDependencyResult - check set Bower.Dependency{..} = case Text.stripPrefix "purescript-" name of + check packageSet Bower.Dependency{..} = case Text.stripPrefix "purescript-" name of Nothing -> NonPureScript name - Just package -> case Map.lookup (PackageName package) set of - Nothing -> Missing package - Just Package{..} -> case hush $ SemVer.parseSemVer version of + Just package -> case Map.lookup (PackageName package) packageSet of + Just Package{ location = Remote{..}, .. } -> case hush $ SemVer.parseSemVer version of Nothing -> WrongVersion package rangeText version Just v -> if SemVer.matches range v then Match package rangeText version else WrongVersion package rangeText version + _ -> Missing package + display :: BowerDependencyResult -> Text display = \case Match package range actual -> package <> " " <> actual <> " matches " <> range Missing package -> package <> " is not in the package set" NonPureScript name -> name <> " is not a PureScript package" WrongVersion package range actual -> package <> " " <> actual <> " does not match " <> range + isWarning = \case Match _ _ _ -> False _ -> True diff --git a/src/Spago/PscPackage.hs b/src/Spago/PscPackage.hs index 775ea7507..a0a514c2f 100644 --- a/src/Spago/PscPackage.hs +++ b/src/Spago/PscPackage.hs @@ -65,7 +65,7 @@ dhallToJSON inputPath outputPath = do dhall <- readTextFile $ T.fromText inputPath - jsonVal <- Dhall.JSON.codeToValue Dhall.JSON.NoConversion Dhall.JSON.ForbidWithinJSON inputPath dhall + jsonVal <- liftIO $ Dhall.JSON.codeToValue Dhall.JSON.NoConversion Dhall.JSON.ForbidWithinJSON inputPath dhall writeTextFile outputPath $ Text.decodeUtf8 diff --git a/stack.yaml.lock b/stack.yaml.lock index 735adcf88..b57a9f98b 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -141,6 +141,13 @@ packages: sha256: 04bfabd50736570361f5f54d29be6d26b21459c2ccabb10abe40e79d6b763f30 original: hackage: th-lift-instances-0.1.13@sha256:2852e468511805cb25d9e3923c9e91647d008ab4a764ec0921e5e40ff8a8e874,2625 +- completed: + hackage: semver-range-0.2.8@sha256:44918080c220cf67b6e7c8ad16f01f3cfe1ac69d4f72e528e84d566348bb23c3,1941 + pantry-tree: + size: 401 + sha256: fd72964da8246cc09d477b4c6e6f20971de058917d08d9f8183f5c0e2116f9c6 + original: + hackage: semver-range-0.2.8 snapshots: - completed: size: 508406 From 6d6d97fc24db020aaae127c4ab477a9760e28af6 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Mon, 29 Jul 2019 10:17:32 +0300 Subject: [PATCH 16/16] Switch to upstream dhall package --- src/Spago/Version.hs | 1 - stack.yaml | 9 +++----- stack.yaml.lock | 50 ++++++++++++++------------------------------ 3 files changed, 19 insertions(+), 41 deletions(-) diff --git a/src/Spago/Version.hs b/src/Spago/Version.hs index 34fd9539b..1323bc18f 100644 --- a/src/Spago/Version.hs +++ b/src/Spago/Version.hs @@ -17,7 +17,6 @@ import qualified Safe.Foldable as Safe import qualified Spago.Bower as Bower import Spago.DryRun (DryAction (..), DryRun (..), runDryActions) import qualified Spago.Git as Git -import Spago.Messages (surroundQuote) data VersionBump diff --git a/stack.yaml b/stack.yaml index a8751ed73..fbe356fb3 100644 --- a/stack.yaml +++ b/stack.yaml @@ -2,11 +2,8 @@ resolver: lts-12.21 packages: - . extra-deps: -- github: dhall-lang/dhall-haskell - commit: 354346be91ca62d64a1d68dcf7897e5a30f8646c - subdirs: - - dhall - - dhall-json +- dhall-1.25.0 +- dhall-json-1.4.0 - async-pool-0.9.0.2 - either-5 - cborg-json-0.2.1.0@sha256:af9137557002ca5308fe80570a9a29398dfb9708423870875223796760689ac3 @@ -19,7 +16,7 @@ extra-deps: - Glob-0.10.0 - turtle-1.5.14 - libyaml-0.1.1.0@sha256:b3fcd8c44622c75e054c2267f3fec39a58a311748000310cbc8257a4683d3f02,2090 -- yaml-0.11.0.0@sha256:8303b3e445295f4fe28ee18efe49ef2667f9f88742ce8049db437c6579be425e,5079 +- yaml-0.11.1.0@sha256:3dc3ed2760f6d1bb280b3a2da29f9032f508d57bfc545fb16b1424f2a5560641,5079 - th-lift-0.8.0.1@sha256:cceb81b12c0580e02a7a3898b6d60cca5e1be080741f69ddde4f12210d8ba7ca,1960 - th-lift-instances-0.1.13@sha256:2852e468511805cb25d9e3923c9e91647d008ab4a764ec0921e5e40ff8a8e874,2625 - semver-range-0.2.8 diff --git a/stack.yaml.lock b/stack.yaml.lock index b57a9f98b..44dced307 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -5,37 +5,19 @@ packages: - completed: - size: 300776 - subdir: dhall - url: https://github.com/dhall-lang/dhall-haskell/archive/354346be91ca62d64a1d68dcf7897e5a30f8646c.tar.gz - cabal-file: - size: 40233 - sha256: a322ba6dea998b227e3edefca0c841081a42e9f7924e5dbf711c691f60a35cbc - name: dhall - version: 1.24.0 - sha256: 0b46c36486429c7a7466b3d7fa7c9c9a3186ab003759de7eb2b85199323a9f9a - pantry-tree: - size: 8842 - sha256: 584a497c36f5e77def27eed68aec6f2a249ce28b16b52c3d412cd70e76fa8122 - original: - subdir: dhall - url: https://github.com/dhall-lang/dhall-haskell/archive/354346be91ca62d64a1d68dcf7897e5a30f8646c.tar.gz -- completed: - size: 300776 - subdir: dhall-json - url: https://github.com/dhall-lang/dhall-haskell/archive/354346be91ca62d64a1d68dcf7897e5a30f8646c.tar.gz - cabal-file: - size: 5634 - sha256: f22a2afb411cdaa44a2db338fc34bed92c384f48b532d867500f3176f70e0c87 - name: dhall-json - version: 1.3.0 - sha256: 0b46c36486429c7a7466b3d7fa7c9c9a3186ab003759de7eb2b85199323a9f9a - pantry-tree: - size: 2868 - sha256: 489ecc094d28f092559914ac6ac4fb022bae483fefcfe86878850e7af6416046 - original: - subdir: dhall-json - url: https://github.com/dhall-lang/dhall-haskell/archive/354346be91ca62d64a1d68dcf7897e5a30f8646c.tar.gz + hackage: dhall-1.25.0@sha256:1c6724d963bf3428ddf0336f916e3f9bc429bf81ed2e27a8855dbbee11d89fe2,40352 + pantry-tree: + size: 225143 + sha256: 0ed1fb4d2bc400d71e9445199f5af8985ba8e1faad029b416745aa4ac5c8f20d + original: + hackage: dhall-1.25.0 +- completed: + hackage: dhall-json-1.4.0@sha256:74f6422e7b84d32f9965b604e09bc1eb10dc4b9693f735be30a5fb1e4dd61478,5240 + pantry-tree: + size: 2261 + sha256: fee6d6d1be4a2e1ef1ce1986a89f71a5ef95fb55e519db475e1f3ac9e76b9662 + original: + hackage: dhall-json-1.4.0 - completed: hackage: async-pool-0.9.0.2@sha256:3aca5861a7b839d02a3f5c52ad6d1ce368631003f68c3d9cb6d711c29e9618db,1599 pantry-tree: @@ -121,12 +103,12 @@ packages: original: hackage: libyaml-0.1.1.0@sha256:b3fcd8c44622c75e054c2267f3fec39a58a311748000310cbc8257a4683d3f02,2090 - completed: - hackage: yaml-0.11.0.0@sha256:8303b3e445295f4fe28ee18efe49ef2667f9f88742ce8049db437c6579be425e,5079 + hackage: yaml-0.11.1.0@sha256:3dc3ed2760f6d1bb280b3a2da29f9032f508d57bfc545fb16b1424f2a5560641,5079 pantry-tree: size: 1989 - sha256: f95eb551d1bebfe405eb7c2901e2eaba9ea17d379fc984bd04d44d4831d3fbca + sha256: 91ad3e06ba3ea11c4de1d0bdbdaeedbe4e4a5b1e4caf20bf1dc36f7b954e47e5 original: - hackage: yaml-0.11.0.0@sha256:8303b3e445295f4fe28ee18efe49ef2667f9f88742ce8049db437c6579be425e,5079 + hackage: yaml-0.11.1.0@sha256:3dc3ed2760f6d1bb280b3a2da29f9032f508d57bfc545fb16b1424f2a5560641,5079 - completed: hackage: th-lift-0.8.0.1@sha256:cceb81b12c0580e02a7a3898b6d60cca5e1be080741f69ddde4f12210d8ba7ca,1960 pantry-tree: