Reimplement spago to manifest code

app/fixtures/spago-yaml/registry-lib.yaml

@@ -0,0 +1,13 @@
+package:
+  name: registry-lib
+  publish:
+    version: 0.0.1
+    license: BSD-3-Clause
+    location:
+      githubOwner: purescript
+      githubRepo: registry-dev
+      subdir: lib
+  dependencies:
+    - prelude: ">=1.0.0 <2.0.0"
+  test:
+    main: Test.Registry

app/spago.yaml

@@ -63,7 +63,6 @@ package:
     - registry-lib
     - run
     - safe-coerce
-    - spago-core
     - strings
     - these
     - transformers

app/src/App/API.purs

@@ -30,8 +30,7 @@ import Data.Set as Set
 import Data.Set.NonEmpty as NonEmptySet
 import Data.String as String
 import Data.String.CodeUnits as String.CodeUnits
-import Data.String.NonEmpty (fromString) as NonEmptyString
-import Data.String.NonEmpty.Internal (toString) as NonEmptyString
+import Data.String.NonEmpty as NonEmptyString
 import Data.String.Regex as Regex
 import Effect.Aff as Aff
 import Effect.Ref as Ref
@@ -71,6 +70,7 @@ import Registry.App.Legacy.LenientVersion as LenientVersion
 import Registry.App.Legacy.Manifest (LEGACY_CACHE)
 import Registry.App.Legacy.Manifest as Legacy.Manifest
 import Registry.App.Legacy.Types (RawPackageName(..), RawVersion(..), rawPackageNameMapCodec)
+import Registry.App.Manifest.SpagoYaml as SpagoYaml
 import Registry.Constants (ignoredDirectories, ignoredFiles, ignoredGlobs, includedGlobs, includedInsensitiveGlobs)
 import Registry.Foreign.FSExtra as FS.Extra
 import Registry.Foreign.FastGlob as FastGlob
@@ -98,9 +98,6 @@ import Run (AFF, EFFECT, Run)
 import Run as Run
 import Run.Except (EXCEPT)
 import Run.Except as Except
-import Spago.Core.Config as Spago.Config
-import Spago.Core.Prelude as Spago.Prelude
-import Spago.Log as Spago.Log
 
 type PackageSetUpdateEffects r = (REGISTRY + PACKAGE_SETS + GITHUB + GITHUB_EVENT_ENV + COMMENT + LOG + EXCEPT String + r)
 
@@ -419,30 +416,19 @@ publish source payload = do
 
     else if hasSpagoYaml then do
       Comment.comment $ "Package source does not have a purs.json file, creating one from your spago.yaml file..."
-      -- Need to make a Spago log env first, disable the logging
-      let spagoEnv = { logOptions: { color: false, verbosity: Spago.Log.LogQuiet } }
-      Spago.Prelude.runSpago spagoEnv (Spago.Config.readConfig packageSpagoYaml) >>= case _ of
-        Left readErr -> Except.throw $ String.joinWith "\n"
-          [ "Could not publish your package - a spago.yaml was present, but it was not possible to read it:"
-          , readErr
-          ]
-        Right { yaml: config } -> do
-          -- Once we have the config we are still not entirely sure it fits into a Manifest
-          -- E.g. need to make sure all the ranges are present
-          case spagoToManifest config of
-            Left err -> Except.throw $ String.joinWith "\n"
-              [ "Could not publish your package - there was an error while converting your spago.yaml into a purs.json manifest:"
-              , err
+      SpagoYaml.readSpagoYaml packageSpagoYaml >>= case _ of
+        Left readErr -> Except.throw $ "Could not publish your package - a spago.yaml was present, but it was not possible to read it:\n" <> readErr
+        Right config -> case SpagoYaml.spagoYamlToManifest config of
+          Left err -> Except.throw $ "Could not publish your package - there was an error while converting your spago.yaml into a purs.json manifest:\n" <> err
+          Right manifest -> do
+            Comment.comment $ Array.fold
+              [ "Converted your spago.yaml into a purs.json manifest to use for publishing:\n"
+              , "```json"
+              , printJson Manifest.codec manifest
+              , "```"
               ]
-            Right manifest -> do
-              Log.debug "Successfully converted a spago.yaml into a purs.json manifest"
-              Comment.comment $ Array.fold
-                [ "Converted your spago.yaml into a purs.json manifest to use for publishing:\n"
-                , "```json"
-                , printJson Manifest.codec manifest
-                , "```"
-                ]
-              pure manifest
+            pure manifest
+
     else do
       Comment.comment $ "Package source does not have a purs.json file. Creating one from your bower.json and/or spago.dhall files..."
       address <- case existingMetadata.location of
@@ -1175,31 +1161,3 @@ getPacchettiBotti = do
 
 packagingTeam :: Team
 packagingTeam = { org: "purescript", team: "packaging" }
-
-spagoToManifest :: Spago.Config.Config -> Either String Manifest
-spagoToManifest config = do
-  package@{ name, description, dependencies: Spago.Config.Dependencies deps } <- note "Did not find a package in the config" config.package
-  publishConfig@{ version, license } <- note "Did not find a `publish` section in the package config" package.publish
-  let includeFiles = NonEmptyArray.fromArray =<< (Array.mapMaybe NonEmptyString.fromString <$> publishConfig.include)
-  let excludeFiles = NonEmptyArray.fromArray =<< (Array.mapMaybe NonEmptyString.fromString <$> publishConfig.exclude)
-  location <- note "Did not find a `location` field in the publish config" publishConfig.location
-  let
-    checkRange :: Tuple PackageName (Maybe Range) -> Either PackageName (Tuple PackageName Range)
-    checkRange (Tuple packageName maybeRange) = case maybeRange of
-      Nothing -> Left packageName
-      Just r -> Right (Tuple packageName r)
-  let { fail: failedPackages, success } = partitionEithers $ map checkRange (Map.toUnfoldable deps :: Array _)
-  dependencies <- case failedPackages of
-    [] -> Right (Map.fromFoldable success)
-    errs -> Left $ "The following packages did not have their ranges specified: " <> String.joinWith ", " (map PackageName.print errs)
-  pure $ Manifest
-    { version
-    , license
-    , name
-    , location
-    , description
-    , dependencies
-    , owners: Nothing -- TODO Spago still needs to add this to its config
-    , includeFiles
-    , excludeFiles
-    }

app/src/App/Manifest/SpagoYaml.purs

@@ -0,0 +1,169 @@
+-- | This module defines the Registry decoder for spago.yaml files, one of the
+-- | supported package manager manifest types.
+module Registry.App.Manifest.SpagoYaml where
+
+import Registry.App.Prelude
+
+import Data.Array as Array
+import Data.Array.NonEmpty as NonEmptyArray
+import Data.Codec.Argonaut (JsonDecodeError(..))
+import Data.Codec.Argonaut as CA
+import Data.Codec.Argonaut.Common as CA.Common
+import Data.Codec.Argonaut.Record as CA.Record
+import Data.Map as Map
+import Data.Profunctor as Profunctor
+import Data.Set as Set
+import Data.String as String
+import Data.String.NonEmpty as NonEmptyString
+import Registry.Internal.Codec as Internal.Codec
+import Registry.License as License
+import Registry.Location as Location
+import Registry.Manifest (Manifest(..))
+import Registry.Owner as Owner
+import Registry.PackageName (PackageName)
+import Registry.PackageName as PackageName
+import Registry.Range (Range)
+import Registry.Range as Range
+import Registry.Version as Version
+
+-- | Attempt to convert a spago.yaml file to a Manifest
+spagoYamlToManifest :: SpagoYaml -> Either String Manifest
+spagoYamlToManifest config = do
+  package@{ name, description, dependencies: spagoDependencies } <- note "No 'package' key found in config." config.package
+  publish@{ version, license, owners } <- note "No 'publish' key found under the 'package' key in config." package.publish
+  location <- note "No 'location' key found under the 'publish' key in config." publish.location
+  let includeFiles = NonEmptyArray.fromArray =<< (Array.mapMaybe NonEmptyString.fromString <$> publish.include)
+  let excludeFiles = NonEmptyArray.fromArray =<< (Array.mapMaybe NonEmptyString.fromString <$> publish.exclude)
+  let printRangeError packages = "The following packages did not have their ranges specified: " <> String.joinWith ", " (map PackageName.print (Set.toUnfoldable packages))
+  dependencies <- lmap printRangeError $ convertSpagoDependencies spagoDependencies
+  pure $ Manifest
+    { name
+    , version
+    , description
+    , license
+    , location
+    , owners
+    , includeFiles
+    , excludeFiles
+    , dependencies
+    }
+
+-- | Read a spago.yaml file from disk at the specified path.
+readSpagoYaml :: forall m. MonadAff m => FilePath -> m (Either String SpagoYaml)
+readSpagoYaml = liftAff <<< readYamlFile spagoYamlCodec
+
+-- | A spago.yaml config
+type SpagoYaml = { package :: Maybe PackageConfig }
+
+spagoYamlCodec :: JsonCodec SpagoYaml
+spagoYamlCodec = CA.Record.object "SpagoYaml"
+  { package: CA.Record.optional packageConfigCodec
+  }
+
+type PackageConfig =
+  { name :: PackageName
+  , description :: Maybe String
+  , dependencies :: Map PackageName (Maybe SpagoRange)
+  , publish :: Maybe PublishConfig
+  }
+
+packageConfigCodec :: JsonCodec PackageConfig
+packageConfigCodec = CA.Record.object "PackageConfig"
+  { name: PackageName.codec
+  , description: CA.Record.optional CA.string
+  , dependencies: dependenciesCodec
+  , publish: CA.Record.optional publishConfigCodec
+  }
+
+type PublishConfig =
+  { version :: Version
+  , license :: License
+  , location :: Maybe Location
+  , include :: Maybe (Array String)
+  , exclude :: Maybe (Array String)
+  , owners :: Maybe (NonEmptyArray Owner)
+  }
+
+publishConfigCodec :: JsonCodec PublishConfig
+publishConfigCodec = CA.Record.object "PublishConfig"
+  { version: Version.codec
+  , license: License.codec
+  , location: CA.Record.optional Location.codec
+  , include: CA.Record.optional (CA.array CA.string)
+  , exclude: CA.Record.optional (CA.array CA.string)
+  , owners: CA.Record.optional (CA.Common.nonEmptyArray Owner.codec)
+  }
+
+dependenciesCodec :: JsonCodec (Map PackageName (Maybe SpagoRange))
+dependenciesCodec = Profunctor.dimap toJsonRep fromJsonRep $ CA.array dependencyCodec
+  where
+  -- Dependencies are encoded as an array, where the array can contain either
+  -- a package name only (no range), or a package name with "*" (unbounded range),
+  --  or a valid Registry range.
+  toJsonRep :: Map PackageName (Maybe SpagoRange) -> Array (Either PackageName (Tuple PackageName SpagoRange))
+  toJsonRep deps = do
+    let convert (Tuple name maybeSpagoRange) = maybe (Left name) (Right <<< Tuple name) maybeSpagoRange
+    map convert $ Map.toUnfoldable deps
+
+  fromJsonRep :: Array (Either PackageName (Tuple PackageName SpagoRange)) -> Map PackageName (Maybe SpagoRange)
+  fromJsonRep = Map.fromFoldable <<< map (either (\name -> Tuple name Nothing) (map Just))
+
+  -- Pairs of package name & range are encoded as a singleton map in the conversion
+  -- from YAML to JSON, so we decode the received map explicitly as a tuple.
+  singletonCodec :: JsonCodec (Tuple PackageName SpagoRange)
+  singletonCodec = CA.codec' decode encode
+    where
+    encode (Tuple name range) = CA.encode (Internal.Codec.packageMap spagoRangeCodec) (Map.singleton name range)
+    decode json = do
+      singleton <- CA.decode (Internal.Codec.packageMap spagoRangeCodec) json
+      case Map.toUnfoldable singleton of
+        [ Tuple name range ] -> Right (Tuple name range)
+        [] -> Left $ TypeMismatch "Expected a singleton map but received an empty one"
+        xs -> Left $ TypeMismatch $ "Expected a singleton map but received a map with " <> show (Array.length xs) <> " elements."
+
+  dependencyCodec :: JsonCodec (Either PackageName (Tuple PackageName SpagoRange))
+  dependencyCodec = CA.codec' decode encode
+    where
+    encode = case _ of
+      Left name -> CA.encode PackageName.codec name
+      Right tuple -> CA.encode singletonCodec tuple
+
+    decode json =
+      map Left (CA.decode PackageName.codec json)
+        <|> map Right (CA.decode singletonCodec json)
+
+convertSpagoDependencies :: Map PackageName (Maybe SpagoRange) -> Either (Set PackageName) (Map PackageName Range)
+convertSpagoDependencies dependencies = do
+  let
+    convert :: Tuple PackageName (Maybe SpagoRange) -> Either PackageName (Tuple PackageName Range)
+    convert (Tuple name maybeSpagoRange) = case maybeSpagoRange of
+      Nothing -> Left name
+      Just Unbounded -> Left name
+      Just (Bounded range) -> Right (Tuple name range)
+
+    partitioned = partitionEithers $ map convert $ Map.toUnfoldable dependencies
+
+  if Array.null partitioned.fail then
+    Right $ Map.fromFoldable partitioned.success
+  else
+    Left $ Set.fromFoldable partitioned.fail
+
+-- | A range specifier in a Spago configuration, which can be either "*"
+-- | (an unbounded range) or a valid Registry range.
+data SpagoRange = Unbounded | Bounded Range
+
+parseSpagoRange :: String -> Either String SpagoRange
+parseSpagoRange = case _ of
+  "*" -> Right Unbounded
+  range -> Bounded <$> Range.parse range
+
+printSpagoRange :: SpagoRange -> String
+printSpagoRange = case _ of
+  Unbounded -> "*"
+  Bounded range -> Range.print range
+
+spagoRangeCodec :: JsonCodec SpagoRange
+spagoRangeCodec = CA.codec' decode encode
+  where
+  encode = CA.encode CA.string <<< printSpagoRange
+  decode = CA.decode CA.string >=> parseSpagoRange >>> lmap (append "SpagoRange: " >>> CA.TypeMismatch)

app/src/App/Prelude.purs

@@ -20,11 +20,13 @@ module Registry.App.Prelude
   , pacchettibottiEmail
   , pacchettibottiKeyType
   , parseJson
+  , parseYaml
   , partitionEithers
   , printJson
   , printPackageSource
   , pursPublishMethod
   , readJsonFile
+  , readYamlFile
   , scratchDir
   , stringifyJson
   , traverseKeys
@@ -86,6 +88,7 @@ import Node.Encoding (Encoding(..)) as Extra
 import Node.FS.Aff as FS.Aff
 import Node.Path (FilePath) as Extra
 import Partial.Unsafe (unsafeCrashWith) as Extra
+import Registry.Foreign.Yaml as Yaml
 import Registry.PackageName (stripPureScriptPrefix) as Extra
 import Registry.PackageName as PackageName
 import Registry.Types (License, Location(..), Manifest(..), ManifestIndex, Metadata(..), Owner(..), PackageName, PackageSet(..), PublishedMetadata, Range, Sha256, UnpublishedMetadata, Version)
@@ -132,6 +135,18 @@ readJsonFile codec path = do
   result <- Aff.attempt $ FS.Aff.readTextFile Extra.UTF8 path
   pure (Extra.lmap Aff.message result >>= parseJson codec >>> Extra.lmap CA.printJsonDecodeError)
 
+-- | Parse a type from a string of YAML data after converting it to JSON.
+parseYaml :: forall a. Extra.JsonCodec a -> String -> Either.Either String a
+parseYaml codec yaml = do
+  json <- Extra.lmap (append "YAML: ") (Yaml.yamlParser yaml)
+  Extra.lmap CA.printJsonDecodeError (CA.decode codec json)
+
+-- | Decode data from a YAML file at the provided filepath
+readYamlFile :: forall a. Extra.JsonCodec a -> Extra.FilePath -> Extra.Aff (Either.Either String a)
+readYamlFile codec path = do
+  result <- Aff.attempt $ FS.Aff.readTextFile Extra.UTF8 path
+  pure (Extra.lmap Aff.message result >>= parseYaml codec)
+
 -- | Partition an array of `Either` values into failure and success  values
 partitionEithers :: forall e a. Array (Either.Either e a) -> { fail :: Array e, success :: Array a }
 partitionEithers = Array.foldMap case _ of

app/test/App/CLI/Licensee.purs

@@ -10,7 +10,7 @@ import Test.Spec as Spec
 
 spec :: Spec.Spec Unit
 spec = do
-  let fixtures = Path.concat [ "app", "fixtures", "manifest-files", "halogen-hooks" ]
+  let fixtures = Path.concat [ "app", "fixtures", "licenses", "halogen-hooks" ]
 
   Spec.it "Detects from directory" do
     detected <- Licensee.detect fixtures
@@ -62,7 +62,7 @@ readFiles = do
   pure { license, packageJson, spagoDhall, bowerJson }
 
 fixtureFile :: FilePath -> FilePath
-fixtureFile file = Path.concat [ "app", "fixtures", "manifest-files", "halogen-hooks", file ]
+fixtureFile file = Path.concat [ "app", "fixtures", "licenses", "halogen-hooks", file ]
 
 readLicense :: Aff String
 readLicense = FS.Aff.readTextFile UTF8 $ fixtureFile "LICENSE"

app/test/App/Manifest/SpagoYaml.purs

@@ -0,0 +1,24 @@
+module Test.Registry.App.Manifest.SpagoYaml where
+
+import Registry.App.Prelude
+
+import Effect.Aff as Aff
+import Node.FS.Aff as FS.Aff
+import Node.Path as Path
+import Registry.App.Manifest.SpagoYaml as SpagoYaml
+import Registry.Test.Assert as Assert
+import Test.Spec (Spec)
+import Test.Spec as Spec
+
+spec :: Spec Unit
+spec = do
+  Spec.it "Parses spago.yaml fixtures" do
+    let fixturesPath = Path.concat [ "app", "fixtures", "spago-yaml" ]
+    fixturePaths <- FS.Aff.readdir fixturesPath
+    for_ fixturePaths \path -> do
+      config <- SpagoYaml.readSpagoYaml (Path.concat [ fixturesPath, path ]) >>= case _ of
+        Left err -> Aff.throwError $ Aff.error err
+        Right config -> pure config
+      case SpagoYaml.spagoYamlToManifest config of
+        Left err -> Assert.fail $ path <> " failed: " <> err
+        Right _ -> pure unit