Implement simple versions and ranges (#305)

Author: thomashoneyman

ci/src/Foreign/SemVer.js

@@ -1,21 +1,4 @@
 const semver = require("semver");
 
-exports.parseSemVerImpl = (input) => {
-  try {
-    return semver.parse(input);
-  } catch (e) {
-    return null;
-  }
-};
-
-exports.version = function (sv) { return sv.version; }
-exports.major = function (sv) { return sv.major; }
-exports.minor = function (sv) { return sv.minor; }
-exports.prerelease = function (sv) { return sv.prerelease; }
-exports.build = function (sv) { return sv.build; }
-exports.patch = function (sv) { return sv.patch; }
-exports.raw = function(sv) { return sv.raw; }
-
-exports.compareSemVerImpl = semver.compare;
-
-exports.parseRangeImpl = semver.validRange;
+exports.parseRangeImpl = (rangeString) =>
+  semver.validRange(rangeString, { loose: true, includePrerelease: false });

ci/src/Foreign/SemVer.purs

@@ -1,82 +1,14 @@
 module Foreign.SemVer
-  ( SemVer
-  , parseSemVer
-  , raw
-  , version
-  , major
-  , minor
-  , patch
-  , prerelease
-  , build
-  , Range
-  , parseRange
-  , printRange
+  ( parseRange
   ) where
 
 import Registry.Prelude
 
-import Data.Function.Uncurried (Fn2, runFn2)
 import Data.String as String
-import Registry.Json as Json
-
-data SemVer
-
-instance eqSemVer :: Eq SemVer where
-  eq v1 v2 = compare v1 v2 == EQ
-
-instance ordSemVer :: Ord SemVer where
-  compare = compareSemVer
-
-instance showSemVer :: Show SemVer where
-  show = raw
-
-instance RegistryJson SemVer where
-  encode = Json.encode <<< version
-  decode json = do
-    versionString <- Json.decode json
-    note ("Expected version: " <> versionString) (parseSemVer versionString)
-
-foreign import compareSemVerImpl :: Fn2 SemVer SemVer Int
-
-compareSemVer :: SemVer -> SemVer -> Ordering
-compareSemVer v1 v2 = case runFn2 compareSemVerImpl v1 v2 of
-  (-1) -> LT
-  0 -> EQ
-  1 -> GT
-  other -> unsafeCrashWith $ "Unknown ordering: " <> show other
-
-foreign import parseSemVerImpl :: String -> Nullable SemVer
-
-parseSemVer :: String -> Maybe SemVer
-parseSemVer = toMaybe <<< parseSemVerImpl
-
-foreign import major :: SemVer -> Int
-
-foreign import minor :: SemVer -> Int
-
-foreign import patch :: SemVer -> Int
-
-foreign import prerelease :: SemVer -> Array String
-
-foreign import build :: SemVer -> Array String
-
-foreign import version :: SemVer -> String
-
-foreign import raw :: SemVer -> String
-
-newtype Range = Range String
-
-derive newtype instance eqRange :: Eq Range
-
-instance RegistryJson Range where
-  encode = Json.encode <<< printRange
-  decode json = do
-    original <- Json.decode json
-    note ("Expected SemVer range: " <> original) (parseRange original)
 
 foreign import parseRangeImpl :: String -> Nullable String
 
-parseRange :: String -> Maybe Range
+parseRange :: String -> Maybe String
 parseRange original = do
   converted <- case toMaybe (parseRangeImpl original) of
     Just c -> pure c
@@ -88,10 +20,4 @@ parseRange original = do
           Just c -> pure c
           _ -> Nothing
         _ -> Nothing
-  pure $ Range converted
-
-printRange :: Range -> String
-printRange (Range r) = r
-
-instance Show Range where
-  show = printRange
+  pure converted

ci/src/Registry/API.purs

@@ -15,8 +15,6 @@ import Foreign.Dhall as Dhall
 import Foreign.GitHub (IssueNumber)
 import Foreign.GitHub as GitHub
 import Foreign.Object as Object
-import Foreign.SemVer (SemVer)
-import Foreign.SemVer as SemVer
 import Foreign.Tar as Tar
 import Foreign.Tmp as Tmp
 import Node.ChildProcess as NodeProcess
@@ -34,6 +32,8 @@ import Registry.Schema (Manifest(..), Metadata, Operation(..), Repo(..), Target(
 import Registry.Scripts.LegacyImport.Error (ImportError(..))
 import Registry.Scripts.LegacyImport.Manifest as Manifest
 import Registry.Types (RawPackageName(..), RawVersion(..))
+import Registry.Version (ParseMode(..), Version)
+import Registry.Version as Version
 import Sunde as Process
 import Text.Parsing.StringParser as StringParser
 
@@ -166,9 +166,9 @@ addOrUpdate { ref, fromBower, packageName } metadata = do
       Git _ -> throwWithComment "Legacy packages can only come from GitHub. Aborting."
       GitHub { owner, repo } -> pure { owner, repo }
 
-    semVer <- case SemVer.parseSemVer ref of
-      Nothing -> throwWithComment $ "Not a valid SemVer version: " <> ref
-      Just result -> pure result
+    version <- case Version.parseVersion Lenient ref of
+      Left _ -> throwWithComment $ "Not a valid registry version: " <> ref
+      Right result -> pure result
 
     let
       liftError = map (lmap ManifestImportError)
@@ -179,7 +179,7 @@ addOrUpdate { ref, fromBower, packageName } metadata = do
       gatherManifest :: ExceptT ImportError Aff Manifest
       gatherManifest = do
         manifestFields <- Manifest.constructManifestFields (RawPackageName $ show packageName) (RawVersion ref) address
-        Except.mapExceptT liftError $ Manifest.toManifest packageName metadata.location semVer manifestFields
+        Except.mapExceptT liftError $ Manifest.toManifest packageName metadata.location version manifestFields
 
     runManifest gatherManifest >>= case _ of
       Left err ->
@@ -204,7 +204,7 @@ addOrUpdate { ref, fromBower, packageName } metadata = do
   log "Packaging the tarball to upload..."
   -- We need the version number to upload the package
   let newVersion = manifestRecord.version
-  let newDirname = PackageName.print packageName <> "-" <> SemVer.version newVersion
+  let newDirname = PackageName.print packageName <> "-" <> Version.printVersion newVersion
   liftAff $ FS.rename absoluteFolderPath (tmpDir <> "/" <> newDirname)
   let tarballPath = tmpDir <> "/" <> newDirname <> ".tar.gz"
   liftEffect $ Tar.create { cwd: tmpDir, folderName: newDirname, archiveName: tarballPath }
@@ -218,7 +218,7 @@ addOrUpdate { ref, fromBower, packageName } metadata = do
   log "Uploading package to the storage backend..."
   let uploadPackageInfo = { name: packageName, version: newVersion }
   uploadPackage uploadPackageInfo tarballPath
-  log $ "Adding the new version " <> SemVer.version newVersion <> " to the package metadata file (hashes, etc)"
+  log $ "Adding the new version " <> Version.printVersion newVersion <> " to the package metadata file (hashes, etc)"
   log $ "Hash for ref " <> show ref <> " was " <> show hash
   let newMetadata = addVersionToMetadata newVersion { hash, ref, bytes } metadata
   let metadataFilePath = metadataFile packageName
@@ -260,15 +260,11 @@ runChecks metadata (Manifest manifest) = do
     throwWithComment "The `lib` target only allows the following `sources`: `src/**/*.purs`"
 
   log "Check that version is unique"
-  let prettyVersion = SemVer.version manifest.version
+  let prettyVersion = Version.printVersion manifest.version
   case Object.lookup prettyVersion metadata.releases of
     Nothing -> pure unit
     Just info -> throwWithComment $ "You tried to upload a version that already exists: " <> show prettyVersion <> "\nIts metadata is: " <> show info
 
-  log "Check that the version does not contain any build metadata"
-  when (SemVer.build manifest.version /= []) do
-    throwWithComment "Package version should not contain any build-metadata."
-
   log "Check that all dependencies are contained in the registry"
   packages <- readPackagesMetadata
   let lookupPackage = flip Map.lookup packages <=< (hush <<< PackageName.parse)
@@ -324,7 +320,7 @@ mkMetadataRef = do
     pure $ packageName /\ metadata
   liftEffect $ Ref.new $ Map.fromFoldable packagesArray
 
-isPackageVersionInMetadata :: PackageName -> SemVer -> MetadataMap -> Boolean
+isPackageVersionInMetadata :: PackageName -> Version -> MetadataMap -> Boolean
 isPackageVersionInMetadata packageName version metadataMap =
   case Map.lookup packageName metadataMap of
     Nothing -> false

ci/src/Registry/Index.purs

@@ -14,7 +14,6 @@ import Data.Set as Set
 import Data.String as String
 import Data.String.Pattern (Pattern(..))
 import Foreign.Node.FS as Foreign.Node
-import Foreign.SemVer (SemVer)
 import Node.FS.Aff as FS
 import Node.FS.Stats as Stats
 import Node.Glob.Basic as Glob
@@ -23,8 +22,9 @@ import Registry.Json as Json
 import Registry.PackageName (PackageName)
 import Registry.PackageName as PackageName
 import Registry.Schema (Manifest(..))
+import Registry.Version (Version)
 
-type RegistryIndex = Map PackageName (Map SemVer Manifest)
+type RegistryIndex = Map PackageName (Map Version Manifest)
 
 -- | NOTE: Right now, this assumes that manifest files will parse
 readRegistryIndex :: FilePath -> Aff RegistryIndex
@@ -61,10 +61,10 @@ readRegistryIndex directory = do
     parsedPackages :: Array (Tuple PackageName (NonEmptyArray Manifest))
     parsedPackages = map normalizePackage parsed
 
-    goManifest :: Manifest -> Tuple SemVer Manifest
+    goManifest :: Manifest -> Tuple Version Manifest
     goManifest manifest@(Manifest { version }) = Tuple version manifest
 
-    goPackage :: NonEmptyArray Manifest -> Map SemVer Manifest
+    goPackage :: NonEmptyArray Manifest -> Map Version Manifest
     goPackage = map goManifest >>> Map.fromFoldable
 
   pure

ci/src/Registry/PackageGraph.purs

@@ -16,29 +16,29 @@ import Data.Map as Map
 import Data.Monoid (guard)
 import Data.Set as Set
 import Foreign.Object as Object
-import Foreign.SemVer (Range, SemVer)
 import Registry.Index (RegistryIndex)
 import Registry.PackageName (PackageName)
 import Registry.PackageName as PackageName
 import Registry.Schema (Manifest(..), Target(..))
+import Registry.Version (Range, Version)
 
-type PackageWithVersion = { package :: PackageName, version :: SemVer }
+type PackageWithVersion = { package :: PackageName, version :: Version }
 
 type PackageWithDependencies = { package :: PackageWithVersion, dependencies :: Array PackageName }
 
 type ConstraintArgs =
-  { satisfied :: Map PackageName (Array SemVer)
+  { satisfied :: Map PackageName (Array Version)
   , constraints :: Array PackageWithDependencies
   }
 
 type ConstraintResult =
-  { satisfied :: Map PackageName (Array SemVer)
+  { satisfied :: Map PackageName (Array Version)
   , unsatisfied :: Array PackageWithDependencies
   }
 
 type CheckResult =
   { index :: RegistryIndex
-  , unsatisfied :: Array { package :: PackageName, version :: SemVer, dependencies :: Array PackageName }
+  , unsatisfied :: Array { package :: PackageName, version :: Version, dependencies :: Array PackageName }
   }
 
 -- Produces a maximally self-contained RegistryIndex, recording any unsatisfied dependencies.
@@ -115,7 +115,7 @@ checkRegistryIndex original = do
     else
       { satisfied, unsatisfied: constraints }
 
-  isSolved :: Map PackageName (Array SemVer) -> PackageName -> Boolean
+  isSolved :: Map PackageName (Array Version) -> PackageName -> Boolean
   isSolved solved package = Map.member package solved
 
 topologicalSort :: RegistryIndex -> Array Manifest
@@ -126,7 +126,7 @@ topologicalSort index = do
     $ List.mapMaybe (flip Graph.lookup graph)
     $ Graph.topologicalSort graph
 
-type PackageGraph = Graph (Tuple PackageName SemVer) Manifest
+type PackageGraph = Graph (Tuple PackageName Version) Manifest
 
 -- We will construct an edge to each version of each dependency PackageName.
 -- Note: This function only looks at the `lib` target of a `Manifest`.
@@ -137,19 +137,19 @@ toPackageGraph index =
     $ map (map resolveDependencies)
     $ foldMap flatten
     $ map (map Map.toUnfoldable)
-    $ (Map.toUnfoldable index :: Array (Tuple PackageName (Map SemVer Manifest)))
+    $ (Map.toUnfoldable index :: Array (Tuple PackageName (Map Version Manifest)))
   where
-  allVersions :: Map PackageName (Array SemVer)
+  allVersions :: Map PackageName (Array Version)
   allVersions = map (Map.keys >>> Set.toUnfoldable) index
 
   flatten
-    :: Tuple PackageName (Array (Tuple SemVer Manifest))
-    -> Array (Tuple (Tuple PackageName SemVer) Manifest)
+    :: Tuple PackageName (Array (Tuple Version Manifest))
+    -> Array (Tuple (Tuple PackageName Version) Manifest)
   flatten (Tuple packageName versions) = do
     Tuple version manifest <- versions
     pure $ Tuple (Tuple packageName version) manifest
 
-  resolveDependencies :: Manifest -> Tuple Manifest (List (Tuple PackageName SemVer))
+  resolveDependencies :: Manifest -> Tuple Manifest (List (Tuple PackageName Version))
   resolveDependencies manifest = do
     let
       deps =
@@ -161,7 +161,7 @@ toPackageGraph index =
 
     Tuple manifest deps
 
-  resolveDependency :: Tuple PackageName Range -> Array (Tuple PackageName SemVer)
+  resolveDependency :: Tuple PackageName Range -> Array (Tuple PackageName Version)
   resolveDependency (Tuple dependency _) = do
     depVersions <- maybe [] Array.singleton (Map.lookup dependency allVersions)
     version <- depVersions

ci/src/Registry/PackageUpload.purs

@@ -4,16 +4,16 @@ import Registry.Prelude
 
 import Data.Array as Array
 import Effect.Aff as Aff
-import Foreign.SemVer (SemVer)
-import Foreign.SemVer as SemVer
 import Foreign.S3 as S3
 import Node.FS.Aff as FS
 import Registry.PackageName (PackageName)
 import Registry.PackageName as PackageName
+import Registry.Version (Version)
+import Registry.Version as Version
 
 type PackageInfo =
   { name :: PackageName
-  , version :: SemVer
+  , version :: Version
   }
 
 upload :: PackageInfo -> FilePath -> Aff Unit
@@ -31,7 +31,7 @@ upload { name, version } path = do
     filename = Array.fold
       [ packageName
       , "/"
-      , SemVer.version version
+      , Version.printVersion version
       , ".tar.gz"
       ]