From be0d7ffd1c16aa70e8f065a928e941ebc053c013 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Sat, 8 Jun 2024 20:42:53 +0300 Subject: [PATCH] Port from codec-argonaut to codec-json (#690) --- .gitignore | 1 + app/spago.yaml | 14 ++-- app/src/App/API.purs | 21 +++--- app/src/App/CLI/Licensee.purs | 15 ++-- app/src/App/CLI/Purs.purs | 39 +++++----- app/src/App/Effect/Cache.purs | 13 ++-- app/src/App/Effect/GitHub.purs | 41 +++++----- app/src/App/Effect/Pursuit.purs | 19 ++--- app/src/App/Effect/Registry.purs | 17 +++-- app/src/App/GitHubIssue.purs | 48 ++++++------ app/src/App/Legacy/Manifest.purs | 71 +++++++++--------- app/src/App/Legacy/PackageSet.purs | 16 ++-- app/src/App/Legacy/Types.purs | 49 ++++++------ app/src/App/Manifest/SpagoYaml.purs | 73 +++++++++--------- app/src/App/Prelude.purs | 35 +++++---- app/src/App/Server.purs | 10 +-- app/test/App/CLI/Purs.purs | 11 +-- app/test/App/GitHubIssue.purs | 31 +++++++- app/test/App/Legacy/Manifest.purs | 4 +- foreign/spago.yaml | 10 ++- foreign/src/Foreign/Octokit.purs | 108 +++++++++++++++------------ foreign/src/Foreign/Yaml.purs | 6 +- foreign/test/Foreign/JsonRepair.purs | 49 ++++++------ lib/spago.yaml | 10 ++- lib/src/API/V1.purs | 40 +++++----- lib/src/Internal/Codec.purs | 106 +++++++++++++------------- lib/src/License.purs | 19 +++-- lib/src/Location.purs | 40 +++++----- lib/src/Manifest.purs | 29 ++++--- lib/src/ManifestIndex.purs | 12 +-- lib/src/Metadata.purs | 33 ++++---- lib/src/Operation.purs | 74 +++++++++--------- lib/src/Owner.purs | 15 ++-- lib/src/PackageName.purs | 19 +++-- lib/src/PackageSet.purs | 17 ++--- lib/src/PursGraph.purs | 21 +++--- lib/src/Range.purs | 19 +++-- lib/src/Sha256.purs | 19 +++-- lib/src/Version.purs | 19 +++-- lib/test/Registry/ManifestIndex.purs | 21 +++--- lib/test/Registry/PursGraph.purs | 11 +-- lib/test/Registry/Test/Assert.purs | 13 ++-- lib/test/Registry/Test/Utils.purs | 5 +- scripts/spago.yaml | 6 +- scripts/src/CompilerVersions.purs | 26 +++---- scripts/src/LegacyImporter.purs | 63 ++++++++-------- scripts/src/PackageDeleter.purs | 6 +- scripts/src/PackageTransferrer.purs | 11 +-- scripts/src/Solver.purs | 8 +- scripts/src/VerifyIntegrity.purs | 4 +- spago.lock | 73 ++++++++++-------- spago.yaml | 1 + 52 files changed, 776 insertions(+), 665 deletions(-) diff --git a/.gitignore b/.gitignore index c8c2e4c2b..e0c3a931c 100644 --- a/.gitignore +++ b/.gitignore @@ -17,3 +17,4 @@ result # Keep it secret, keep it safe. .env +.envrc diff --git a/app/spago.yaml b/app/spago.yaml index d02027d44..3919e7bb2 100644 --- a/app/spago.yaml +++ b/app/spago.yaml @@ -8,11 +8,11 @@ package: dependencies: - aff - ansi - - argonaut-core - arrays - b64 - bifunctors - - codec-argonaut + - codec + - codec-json - console - const - control @@ -23,22 +23,23 @@ package: - either - exceptions - exists - - filterable - fetch + - filterable - foldable-traversable + - foreign - foreign-object - formatters - http-methods - httpurple - identity - integers - - js-fetch - js-date - - js-uri + - js-fetch - js-promise-aff + - js-uri + - json - lists - maybe - - media-types - newtype - node-buffer - node-child-process @@ -56,7 +57,6 @@ package: - partial - prelude - profunctor - - profunctor-lenses - record - refs - registry-foreign diff --git a/app/src/App/API.purs b/app/src/App/API.purs index 225e2e245..19e09564c 100644 --- a/app/src/App/API.purs +++ b/app/src/App/API.purs @@ -14,12 +14,12 @@ module Registry.App.API import Registry.App.Prelude -import Data.Argonaut.Parser as Argonaut.Parser +import Codec.JSON.DecodeError as CJ.DecodeError import Data.Array as Array import Data.Array.NonEmpty as NEA import Data.Array.NonEmpty as NonEmptyArray -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Record as CA.Record +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Record as CJ.Record import Data.DateTime (DateTime) import Data.Foldable (traverse_) import Data.FoldableWithIndex (foldMapWithIndex) @@ -34,6 +34,7 @@ import Data.String.NonEmpty as NonEmptyString import Data.String.Regex as Regex import Effect.Aff as Aff import Effect.Ref as Ref +import JSON as JSON import Node.ChildProcess.Types (Exit(..)) import Node.FS.Aff as FS.Aff import Node.FS.Stats as FS.Stats @@ -409,7 +410,7 @@ publish source payload = do Except.throw $ "Found a valid purs.json file in the package source, but it does not typecheck." Right _ -> case parseJson Manifest.codec string of Left err -> do - Log.error $ "Failed to parse manifest: " <> CA.printJsonDecodeError err + Log.error $ "Failed to parse manifest: " <> CJ.DecodeError.print err Except.throw $ "Found a purs.json file in the package source, but it could not be decoded." Right manifest -> do Log.debug $ "Read a valid purs.json manifest from the package source:\n" <> stringifyJson Manifest.codec manifest @@ -604,10 +605,10 @@ publish source payload = do Comment.comment "Failed to prune dependencies for legacy package, continuing anyway..." else do Except.throw "purs graph failed; cannot verify unused dependencies." - Right output -> case Argonaut.Parser.jsonParser output of + Right output -> case JSON.parse output of Left parseErr -> Except.throw $ "Failed to parse purs graph output as JSON while finding unused dependencies: " <> parseErr - Right json -> case CA.decode PursGraph.pursGraphCodec json of - Left decodeErr -> Except.throw $ "Failed to decode JSON from purs graph output while finding unused dependencies: " <> CA.printJsonDecodeError decodeErr + Right json -> case CJ.decode PursGraph.pursGraphCodec json of + Left decodeErr -> Except.throw $ "Failed to decode JSON from purs graph output while finding unused dependencies: " <> CJ.DecodeError.print decodeErr Right graph -> do Log.debug "Got a valid graph of source and dependencies. Removing install dir and associating discovered modules with their packages..." FS.Extra.remove tmpDepsDir @@ -1023,7 +1024,7 @@ publishToPursuit { packageSourceDir, dependenciesDir, compiler, resolutions } = let lines = String.split (String.Pattern "\n") publishResult case Array.last lines of Nothing -> Except.throw "Publishing failed because of an unexpected compiler error. cc @purescript/packaging" - Just jsonString -> case Argonaut.Parser.jsonParser jsonString of + Just jsonString -> case JSON.parse jsonString of Left err -> Except.throw $ String.joinWith "\n" [ "Failed to parse output of publishing. cc @purescript/packaging" , "```" @@ -1042,8 +1043,8 @@ publishToPursuit { packageSourceDir, dependenciesDir, compiler, resolutions } = type PursuitResolutions = Map RawPackageName { version :: Version, path :: FilePath } -pursuitResolutionsCodec :: JsonCodec PursuitResolutions -pursuitResolutionsCodec = rawPackageNameMapCodec $ CA.Record.object "Resolution" { version: Version.codec, path: CA.string } +pursuitResolutionsCodec :: CJ.Codec PursuitResolutions +pursuitResolutionsCodec = rawPackageNameMapCodec $ CJ.named "Resolution" $ CJ.Record.object { version: Version.codec, path: CJ.string } -- Resolutions format: https://github.com/purescript/purescript/pull/3565 -- diff --git a/app/src/App/CLI/Licensee.purs b/app/src/App/CLI/Licensee.purs index 8e602e147..deca32bfa 100644 --- a/app/src/App/CLI/Licensee.purs +++ b/app/src/App/CLI/Licensee.purs @@ -2,10 +2,11 @@ module Registry.App.CLI.Licensee where import Registry.App.Prelude +import Codec.JSON.DecodeError as CJ.DecodeError import Control.Parallel as Parallel import Data.Array as Array -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Record as CA.Record +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Record as CJ.Record import Node.ChildProcess.Types (Exit(..)) import Node.FS.Aff as FS import Node.Library.Execa as Execa @@ -32,15 +33,15 @@ detect directory = do -- but we consider this valid Licensee output. Normally n | n == 0 || n == 1 -> do let - parse :: String -> Either JsonDecodeError (Array String) - parse str = map (map _.spdx_id <<< _.licenses) $ flip parseJson str $ CA.Record.object "Licenses" - { licenses: CA.array $ CA.Record.object "SPDXIds" - { spdx_id: CA.string } + parse :: String -> Either CJ.DecodeError (Array String) + parse str = map (map _.spdx_id <<< _.licenses) $ flip parseJson str $ CJ.named "Licenses" $ CJ.Record.object + { licenses: CJ.array $ CJ.named "SPDXIds" $ CJ.Record.object + { spdx_id: CJ.string } } case parse result.stdout of Left error -> do - let printedError = CA.printJsonDecodeError error + let printedError = CJ.DecodeError.print error Left printedError Right out -> do -- A NOASSERTION result means that a LICENSE file could not be parsed. diff --git a/app/src/App/CLI/Purs.purs b/app/src/App/CLI/Purs.purs index 234ccc09e..7e8d22c90 100644 --- a/app/src/App/CLI/Purs.purs +++ b/app/src/App/CLI/Purs.purs @@ -2,10 +2,11 @@ module Registry.App.CLI.Purs where import Registry.App.Prelude +import Codec.JSON.DecodeError as CJ.DecodeError import Data.Array as Array -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Compat as CA.Compat -import Data.Codec.Argonaut.Record as CA.Record +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Common as CJ.Common +import Data.Codec.JSON.Record as CJ.Record import Data.Foldable (foldMap) import Data.String as String import Node.ChildProcess.Types (Exit(..)) @@ -32,14 +33,14 @@ type CompilerError = , moduleName :: Maybe String } -compilerErrorCodec :: JsonCodec CompilerError -compilerErrorCodec = CA.Record.object "CompilerError" +compilerErrorCodec :: CJ.Codec CompilerError +compilerErrorCodec = CJ.named "CompilerError" $ CJ.Record.object { position: sourcePositionCodec - , message: CA.string - , errorCode: CA.string - , errorLink: CA.string - , filename: CA.string - , moduleName: CA.Compat.maybe CA.string + , message: CJ.string + , errorCode: CJ.string + , errorLink: CJ.string + , filename: CJ.string + , moduleName: CJ.Common.nullable CJ.string } type SourcePosition = @@ -49,12 +50,12 @@ type SourcePosition = , endColumn :: Int } -sourcePositionCodec :: JsonCodec SourcePosition -sourcePositionCodec = CA.Record.object "SourcePosition" - { startLine: CA.int - , startColumn: CA.int - , endLine: CA.int - , endColumn: CA.int +sourcePositionCodec :: CJ.Codec SourcePosition +sourcePositionCodec = CJ.named "SourcePosition" $ CJ.Record.object + { startLine: CJ.int + , startColumn: CJ.int + , endLine: CJ.int + , endColumn: CJ.int } -- TODO: This would be better handled with dodo-printer. @@ -120,8 +121,8 @@ callCompiler compilerArgs = do $ String.replaceAll (String.Pattern ".") (String.Replacement "_") $ Version.print version - errorsCodec = CA.Record.object "CompilerErrors" - { errors: CA.array compilerErrorCodec + errorsCodec = CJ.named "CompilerErrors" $ CJ.Record.object + { errors: CJ.array compilerErrorCodec } result <- _.getResult =<< Execa.execa purs (printCommand compilerArgs.command) (_ { cwd = compilerArgs.cwd }) @@ -137,7 +138,7 @@ callCompiler compilerArgs = do Just version | Right min <- Version.parse "0.14.0", version < min -> result.stderr Just _ -> result.stdout case parseJson errorsCodec output of - Left err -> UnknownError $ String.joinWith "\n" [ result.stdout, result.stderr, CA.printJsonDecodeError err ] + Left err -> UnknownError $ String.joinWith "\n" [ result.stdout, result.stderr, CJ.DecodeError.print err ] Right ({ errors } :: { errors :: Array CompilerError }) | Array.null errors -> UnknownError "Non-normal exit code, but no errors reported." | otherwise -> CompilationError errors diff --git a/app/src/App/Effect/Cache.purs b/app/src/App/Effect/Cache.purs index 04f64c302..15808ff9d 100644 --- a/app/src/App/Effect/Cache.purs +++ b/app/src/App/Effect/Cache.purs @@ -34,8 +34,8 @@ module Registry.App.Effect.Cache import Registry.App.Prelude -import Data.Argonaut.Parser as Argonaut.Parser -import Data.Codec.Argonaut as CA +import Codec.JSON.DecodeError as CJ.DecodeError +import Data.Codec.JSON as CJ import Data.Const (Const(..)) import Data.Exists (Exists) import Data.Exists as Exists @@ -45,6 +45,7 @@ import Data.String as String import Data.Symbol (class IsSymbol) import Effect.Aff as Aff import Effect.Ref as Ref +import JSON as JSON import JSURI as JSURI import Node.FS.Aff as FS.Aff import Node.Path as Path @@ -254,7 +255,7 @@ class FsEncodable key where -- | cache values as something other than JSON or a raw buffer. data FsEncoding :: (Type -> Type -> Type) -> Type -> Type -> Type data FsEncoding z b a - = AsJson String (JsonCodec a) (z a b) + = AsJson String (CJ.Codec a) (z a b) | AsBuffer String (z Buffer b) -- | Handle the Cache effect by caching values on the file system, given a @@ -286,13 +287,13 @@ getFsImpl cacheDir = case _ of Left _ -> do Log.debug $ "No cache file found for " <> id <> " at path " <> path pure $ reply Nothing - Right content -> case Argonaut.Parser.jsonParser content of + Right content -> case JSON.parse content of Left parseError -> do Log.error $ "Found cache file for " <> id <> " at path " <> path <> " but its contents are not valid JSON: " <> parseError deletePathById cacheDir id *> pure (reply Nothing) - Right jsonContent -> case CA.decode codec jsonContent of + Right jsonContent -> case CJ.decode codec jsonContent of Left decodeError -> do - let error = CA.printJsonDecodeError decodeError + let error = CJ.DecodeError.print decodeError Log.error $ "Found cache file for " <> id <> " at path " <> path <> " but its contents could not be decoded with the provided codec:\n" <> error deletePathById cacheDir id *> pure (reply Nothing) Right entry -> do diff --git a/app/src/App/Effect/GitHub.purs b/app/src/App/Effect/GitHub.purs index 2a30a8f87..584832255 100644 --- a/app/src/App/Effect/GitHub.purs +++ b/app/src/App/Effect/GitHub.purs @@ -18,16 +18,17 @@ module Registry.App.Effect.GitHub import Registry.App.Prelude -import Data.Argonaut.Parser as Argonaut.Parser -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Common as CA.Common -import Data.Codec.Argonaut.Record as CA.Record +import Codec.JSON.DecodeError as CJ.DecodeError +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Common as CJ.Common +import Data.Codec.JSON.Record as CJ.Record import Data.DateTime (DateTime) import Data.DateTime as DateTime import Data.Exists as Exists import Data.HTTP.Method (Method(..)) import Data.Time.Duration as Duration import Foreign.Object as Object +import JSON as JSON import Registry.App.Effect.Cache (class FsEncodable, class MemoryEncodable, Cache, CacheRef, FsEncoding(..), MemoryEncoding(..)) import Registry.App.Effect.Cache as Cache import Registry.App.Effect.Env (RESOURCE_ENV) @@ -67,7 +68,7 @@ instance MemoryEncodable GitHubCache where instance FsEncodable GitHubCache where encodeFs = case _ of Request route next -> do - let codec = CA.Common.either Octokit.githubErrorCodec requestResultCodec + let codec = CJ.Common.either Octokit.githubErrorCodec requestResultCodec Exists.mkExists $ AsJson ("Request__" <> Octokit.printGitHubRoute route) codec next data GitHub a @@ -99,14 +100,14 @@ getContent :: forall r. Address -> RawVersion -> FilePath -> Run (GITHUB + r) (E getContent address (RawVersion ref) path = Run.lift _github (GetContent address ref path identity) -- | Read the content of a JSON file in the provided repo, decoding its contents. -getJsonFile :: forall r a. Address -> RawVersion -> JsonCodec a -> FilePath -> Run (GITHUB + r) (Either GitHubError a) +getJsonFile :: forall r a. Address -> RawVersion -> CJ.Codec a -> FilePath -> Run (GITHUB + r) (Either GitHubError a) getJsonFile address ref codec path = do content <- getContent address ref path let - attemptDecode inner = case Argonaut.Parser.jsonParser (JsonRepair.tryRepair inner) of + attemptDecode inner = case JSON.parse (JsonRepair.tryRepair inner) of Left jsonError -> Left $ Octokit.DecodeError $ "Not Json: " <> jsonError - Right json -> case CA.decode codec json of - Left decodeError -> Left $ Octokit.DecodeError $ CA.printJsonDecodeError decodeError + Right json -> case CJ.decode codec json of + Left decodeError -> Left $ Octokit.DecodeError $ CJ.DecodeError.print decodeError Right decoded -> Right decoded pure $ attemptDecode =<< content @@ -178,7 +179,7 @@ request octokit githubRequest@{ route: route@(GitHubRoute method _ _), codec } = case entry of Nothing -> do result <- requestWithBackoff octokit githubRequest - Cache.put _githubCache (Request route) (result <#> \response -> { modified: now, etag: Nothing, response: CA.encode codec response }) + Cache.put _githubCache (Request route) (result <#> \response -> { modified: now, etag: Nothing, response: CJ.encode codec response }) pure result Just cached -> case cached of @@ -195,9 +196,9 @@ request octokit githubRequest@{ route: route@(GitHubRoute method _ _), codec } = Cache.delete _githubCache (Request route) request octokit githubRequest - Right prevResponse -> case CA.decode codec prevResponse.response of + Right prevResponse -> case CJ.decode codec prevResponse.response of Left err -> do - Log.debug $ "Could not decode previous response data using the provided codec: " <> CA.printJsonDecodeError err + Log.debug $ "Could not decode previous response data using the provided codec: " <> CJ.DecodeError.print err Log.debug $ "This indicates an out-of-date cache entry. Clearing cache for route " <> printedRoute Cache.delete _githubCache (Request route) Log.debug "Retrying request..." @@ -216,7 +217,7 @@ request octokit githubRequest@{ route: route@(GitHubRoute method _ _), codec } = Right decoded | Just etag <- prevResponse.etag -> do Log.debug $ "Found valid cache entry with etags for " <> printedRoute let headers = Object.insert "If-None-Match" etag githubRequest.headers - Log.debug $ "Verifying cached status with headers: " <> stringifyJson (CA.Common.foreignObject CA.string) headers + Log.debug $ "Verifying cached status with headers: " <> stringifyJson (CJ.Common.foreignObject CJ.string) headers let modifiedRequest = githubRequest { headers = headers } conditionalResponse <- requestWithBackoff octokit modifiedRequest case conditionalResponse of @@ -234,7 +235,7 @@ request octokit githubRequest@{ route: route@(GitHubRoute method _ _), codec } = Cache.put _githubCache (Request route) (Left otherError) pure (Left otherError) Right valid -> do - Cache.put _githubCache (Request route) (Right { response: CA.encode codec valid, modified: now, etag: Nothing }) + Cache.put _githubCache (Request route) (Right { response: CJ.encode codec valid, modified: now, etag: Nothing }) pure $ Right valid -- Since we don't have support for conditional requests via etags, we'll instead @@ -244,7 +245,7 @@ request octokit githubRequest@{ route: route@(GitHubRoute method _ _), codec } = Right _ | DateTime.diff now prevResponse.modified >= Duration.Hours 4.0 -> do Log.debug $ "Found cache entry but it was modified more than 4 hours ago, refetching " <> printedRoute result <- requestWithBackoff octokit githubRequest - Cache.put _githubCache (Request route) (result <#> \resp -> { response: CA.encode codec resp, modified: now, etag: Nothing }) + Cache.put _githubCache (Request route) (result <#> \resp -> { response: CJ.encode codec resp, modified: now, etag: Nothing }) pure result Right decoded -> do @@ -285,12 +286,12 @@ requestWithBackoff octokit githubRequest = do type RequestResult = { modified :: DateTime , etag :: Maybe String - , response :: Json + , response :: JSON } -requestResultCodec :: JsonCodec RequestResult -requestResultCodec = CA.Record.object "RequestResult" - { etag: CA.Common.maybe CA.string +requestResultCodec :: CJ.Codec RequestResult +requestResultCodec = CJ.named "RequestResult" $ CJ.Record.object + { etag: CJ.Common.maybe CJ.string , modified: Internal.Codec.iso8601DateTime - , response: CA.json + , response: CJ.json } diff --git a/app/src/App/Effect/Pursuit.purs b/app/src/App/Effect/Pursuit.purs index a86b7fbe5..ea3cb61c4 100644 --- a/app/src/App/Effect/Pursuit.purs +++ b/app/src/App/Effect/Pursuit.purs @@ -3,15 +3,16 @@ module Registry.App.Effect.Pursuit where import Registry.App.Prelude -import Data.Argonaut.Core as Argonaut +import Codec.JSON.DecodeError as CJ.DecodeError import Data.Array as Array -import Data.Codec.Argonaut as CA +import Data.Codec.JSON as CJ import Data.HTTP.Method as Method import Data.Map as Map import Data.Profunctor as Profunctor import Effect.Exception as Exception import Fetch.Retry as Fetch import Foreign (unsafeFromForeign) +import JSON as JSON import Registry.App.Effect.Env (RESOURCE_ENV) import Registry.App.Effect.Env as Env import Registry.App.Effect.Log (LOG) @@ -27,7 +28,7 @@ import Run as Run -- | An effect for interacting with Pursuit data Pursuit a - = Publish Json (Either String Unit -> a) + = Publish JSON (Either String Unit -> a) | GetPublishedVersions PackageName (Either String (Map Version URL) -> a) derive instance Functor Pursuit @@ -38,7 +39,7 @@ _pursuit :: Proxy "pursuit" _pursuit = Proxy -- | Publish a package to Pursuit using the JSON output of the compiler. -publish :: forall r. Json -> Run (PURSUIT + r) (Either String Unit) +publish :: forall r. JSON -> Run (PURSUIT + r) (Either String Unit) publish json = Run.lift _pursuit (Publish json identity) -- | List published versions from Pursuit @@ -63,7 +64,7 @@ handleAff (GitHubToken token) = case _ of Log.debug "Pushing to Pursuit..." result <- Run.liftAff do - gzipped <- Gzip.compress (Argonaut.stringify payload) + gzipped <- Gzip.compress (JSON.print payload) Fetch.withRetryRequest (Array.fold [ pursuitApiUrl, "/packages" ]) { method: Method.POST , body: gzipped @@ -119,9 +120,9 @@ handleAff (GitHubToken token) = case _ of pure $ reply $ Left $ "Received non-200 response from Pursuit: " <> show status Succeeded { text: textAff, json: jsonAff } -> do json <- Run.liftAff jsonAff - case CA.decode availableVersionsCodec (unsafeFromForeign json) of + case CJ.decode availableVersionsCodec (unsafeFromForeign json) of Left error -> do - let printed = CA.printJsonDecodeError error + let printed = CJ.DecodeError.print error text <- Run.liftAff textAff Log.error $ "Failed to decode body " <> text <> "\n with error: " <> printed pure $ reply $ Left $ "Received a response from Pursuit, but it could not be decoded:\n\n" <> printed <> "\n\ncc: @purescript/packaging" @@ -132,8 +133,8 @@ handleAff (GitHubToken token) = case _ of -- The Pursuit /available-versions endpoint returns versions as a tuple of the -- version number and documentation URL, represented as a two-element array. -- [["2.0.0","https://pursuit.purescript.org/packages/purescript-halogen/2.0.0"]] -availableVersionsCodec :: JsonCodec (Map Version URL) -availableVersionsCodec = Profunctor.dimap toRep fromRep (CA.array (CA.array CA.string)) +availableVersionsCodec :: CJ.Codec (Map Version URL) +availableVersionsCodec = Profunctor.dimap toRep fromRep (CJ.array (CJ.array CJ.string)) where toRep = map (\(Tuple version url) -> [ Version.print version, url ]) <<< Map.toUnfoldable fromRep = Map.fromFoldable <<< Array.mapMaybe \array -> do diff --git a/app/src/App/Effect/Registry.purs b/app/src/App/Effect/Registry.purs index 05da5d983..cdd00eb1d 100644 --- a/app/src/App/Effect/Registry.purs +++ b/app/src/App/Effect/Registry.purs @@ -5,11 +5,11 @@ module Registry.App.Effect.Registry where import Registry.App.Prelude -import Data.Argonaut.Parser as Argonaut.Parser +import Codec.JSON.DecodeError as CJ.DecodeError import Data.Array as Array import Data.Array.NonEmpty as NonEmptyArray -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Common as CA.Common +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Common as CJ.Common import Data.DateTime (DateTime) import Data.DateTime as DateTime import Data.Exists as Exists @@ -19,6 +19,7 @@ import Data.String as String import Data.Time.Duration as Duration import Effect.Aff as Aff import Effect.Ref as Ref +import JSON as JSON import Node.FS.Aff as FS.Aff import Node.Path as Path import Registry.App.CLI.Git (GitResult) @@ -331,18 +332,18 @@ handle env = Cache.interpret _registryCache (Cache.handleMemory env.cacheRef) << Left fsError -> do Log.debug $ "Could not find metadata file for package " <> printedName <> ": " <> Aff.message fsError pure Nothing - Right contents -> case Argonaut.Parser.jsonParser contents of + Right contents -> case JSON.parse contents of Left jsonError -> Except.throw $ Array.fold [ "Found metadata file for " <> printedName <> " at path " <> path , ", but the file is not valid JSON: " <> jsonError , "\narising from contents:\n" <> contents ] - Right parsed -> case CA.decode Metadata.codec parsed of + Right parsed -> case CJ.decode Metadata.codec parsed of Left decodeError -> do Except.throw $ Array.fold [ "Found metadata file for " <> printedName <> " at path " <> path - , ", but could not decode the JSON" <> CA.printJsonDecodeError decodeError + , ", but could not decode the JSON" <> CJ.DecodeError.print decodeError , "\narising from contents:\n" <> contents ] Right metadata -> do @@ -602,7 +603,7 @@ handle env = Cache.interpret _registryCache (Cache.handleMemory env.cacheRef) << ReadLegacyRegistry reply -> map (map reply) Except.runExcept do let dir = repoPath RegistryRepo Log.info $ "Reading legacy registry from " <> dir - let readRegistryFile path = readJsonFile (CA.Common.strMap CA.string) (Path.concat [ dir, path ]) + let readRegistryFile path = readJsonFile (CJ.Common.strMap CJ.string) (Path.concat [ dir, path ]) bower <- Run.liftAff (readRegistryFile "bower-packages.json") >>= case _ of Left error -> Except.throw $ "Failed to read bower-packages.json file: " <> error Right packages -> pure packages @@ -650,7 +651,7 @@ handle env = Cache.interpret _registryCache (Cache.handleMemory env.cacheRef) << let sourcePackages = if file == "new-packages.json" then new else bower let packages = Map.insert rawPackageName url sourcePackages let path = Path.concat [ dir, file ] - Run.liftAff $ writeJsonFile (CA.Common.strMap CA.string) path packages + Run.liftAff $ writeJsonFile (CJ.Common.strMap CJ.string) path packages pure $ Just $ "Sync " <> PackageName.print name <> " with legacy registry." case result of diff --git a/app/src/App/GitHubIssue.purs b/app/src/App/GitHubIssue.purs index 900d5efb0..2c02604c4 100644 --- a/app/src/App/GitHubIssue.purs +++ b/app/src/App/GitHubIssue.purs @@ -2,15 +2,16 @@ module Registry.App.GitHubIssue where import Registry.App.Prelude -import Data.Argonaut.Parser as Argonaut.Parser +import Codec.JSON.DecodeError as CJ.DecodeError import Data.Array as Array -import Data.Codec.Argonaut as CA +import Data.Codec.JSON as CJ import Data.Foldable (traverse_) import Data.String as String import Effect.Aff as Aff import Effect.Class.Console as Console import Effect.Ref as Ref -import Foreign.Object as Object +import JSON as JSON +import JSON.Object as CJ.Object import Node.FS.Aff as FS.Aff import Node.Path as Path import Node.Process as Process @@ -188,7 +189,7 @@ readOperation :: FilePath -> Aff OperationDecoding readOperation eventPath = do fileContents <- FS.Aff.readTextFile UTF8 eventPath - IssueEvent { issueNumber, body, username } <- case Argonaut.Parser.jsonParser fileContents >>= decodeIssueEvent of + IssueEvent { issueNumber, body, username } <- case JSON.parse fileContents >>= decodeIssueEvent of Left err -> -- If we don't receive a valid event path or the contents can't be decoded -- then this is a catastrophic error and we exit the workflow. @@ -200,28 +201,28 @@ readOperation eventPath = do -- TODO: Right now we parse all operations from GitHub issues, but we should -- in the future only parse out package set operations. The others should be -- handled via a HTTP API. - decodeOperation :: Json -> Either JsonDecodeError (Either PackageSetOperation PackageOperation) + decodeOperation :: JSON -> Either CJ.DecodeError (Either PackageSetOperation PackageOperation) decodeOperation json = do - object <- CA.decode CA.jobject json - let keys = Object.keys object + object <- CJ.decode CJ.jobject json + let keys = CJ.Object.keys object let hasKeys = all (flip Array.elem keys) if hasKeys [ "packages" ] then - map (Left <<< PackageSetUpdate) (CA.decode Operation.packageSetUpdateCodec json) + map (Left <<< PackageSetUpdate) (CJ.decode Operation.packageSetUpdateCodec json) else if hasKeys [ "name", "ref", "compiler" ] then - map (Right <<< Publish) (CA.decode Operation.publishCodec json) + map (Right <<< Publish) (CJ.decode Operation.publishCodec json) else if hasKeys [ "payload", "signature" ] then - map (Right <<< Authenticated) (CA.decode Operation.authenticatedCodec json) + map (Right <<< Authenticated) (CJ.decode Operation.authenticatedCodec json) else - Left $ CA.TypeMismatch "Operation: Expected a valid registry operation, but provided object did not match any operation decoder." + Left $ CJ.DecodeError.basic "Operation: Expected a valid registry operation, but provided object did not match any operation decoder." - case Argonaut.Parser.jsonParser (JsonRepair.tryRepair (firstObject body)) of + case JSON.parse (JsonRepair.tryRepair (firstObject body)) of Left err -> do Console.log "Not JSON." Console.logShow { err, body } pure NotJson Right json -> case decodeOperation json of Left jsonError -> do - let printedError = CA.printJsonDecodeError jsonError + let printedError = CJ.DecodeError.print jsonError Console.log $ "Malformed JSON:\n" <> printedError Console.log $ "Received body:\n" <> body pure $ MalformedJson issueNumber printedError @@ -250,27 +251,20 @@ newtype IssueEvent = IssueEvent derive instance Newtype IssueEvent _ -decodeIssueEvent :: Json -> Either String IssueEvent -decodeIssueEvent json = lmap CA.printJsonDecodeError do - object <- CA.decode CA.jobject json - username <- atKey "login" CA.string =<< atKey "sender" CA.jobject object +decodeIssueEvent :: JSON -> Either String IssueEvent +decodeIssueEvent json = lmap CJ.DecodeError.print do + object <- CJ.decode CJ.jobject json + username <- Octokit.atKey "login" CJ.string =<< Octokit.atKey "sender" CJ.jobject object - issueObject <- atKey "issue" CA.jobject object - issueNumber <- atKey "number" CA.int issueObject + issueObject <- Octokit.atKey "issue" CJ.jobject object + issueNumber <- Octokit.atKey "number" CJ.int issueObject -- We accept issue creation and issue comment events, but both contain an -- 'issue' field. However, only comments contain a 'comment' field. For that -- reason we first try to parse the comment and fall back to the issue if -- that fails. - body <- atKey "body" CA.string =<< atKey "comment" CA.jobject object <|> pure issueObject + body <- Octokit.atKey "body" CJ.string =<< Octokit.atKey "comment" CJ.jobject object <|> pure issueObject pure $ IssueEvent { body, username, issueNumber: IssueNumber issueNumber } - where - atKey :: forall a. String -> JsonCodec a -> Object Json -> Either JsonDecodeError a - atKey key codec object = - maybe - (Left $ CA.AtKey key CA.MissingValue) - (lmap (CA.AtKey key) <<< CA.decode codec) - (Object.lookup key object) -- | Re-sign a payload as pacchettibotti if the authenticated operation was -- | submitted by a registry trustee. diff --git a/app/src/App/Legacy/Manifest.purs b/app/src/App/Legacy/Manifest.purs index b61e15c6e..7788b16c2 100644 --- a/app/src/App/Legacy/Manifest.purs +++ b/app/src/App/Legacy/Manifest.purs @@ -2,11 +2,13 @@ module Registry.App.Legacy.Manifest where import Registry.App.Prelude +import Codec.JSON.DecodeError as CJ.DecodeError import Data.Array as Array -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Common as CA.Common -import Data.Codec.Argonaut.Record as CA.Record -import Data.Codec.Argonaut.Variant as CA.Variant +import Data.Codec as Codec +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Common as CJ.Common +import Data.Codec.JSON.Record as CJ.Record +import Data.Codec.JSON.Variant as CJ.Variant import Data.Either as Either import Data.Exists as Exists import Data.FunctorWithIndex (mapWithIndex) @@ -182,18 +184,18 @@ data LegacyManifestError | InvalidLicense (Array String) | InvalidDependencies (Array { name :: String, range :: String, error :: String }) -legacyManifestErrorCodec :: JsonCodec LegacyManifestError -legacyManifestErrorCodec = Profunctor.dimap toVariant fromVariant $ CA.Variant.variantMatch +legacyManifestErrorCodec :: CJ.Codec LegacyManifestError +legacyManifestErrorCodec = Profunctor.dimap toVariant fromVariant $ CJ.Variant.variantMatch { noManifests: Left unit , missingLicense: Left unit - , invalidLicense: Right (CA.array CA.string) - , invalidDependencies: Right (CA.array dependencyCodec) + , invalidLicense: Right (CJ.array CJ.string) + , invalidDependencies: Right (CJ.array dependencyCodec) } where - dependencyCodec = CA.Record.object "Dependency" - { name: CA.string - , range: CA.string - , error: CA.string + dependencyCodec = CJ.named "Dependency" $ CJ.Record.object + { name: CJ.string + , range: CJ.string + , error: CJ.string } toVariant = case _ of @@ -305,15 +307,15 @@ newtype SpagoDhallJson = SpagoDhallJson derive instance Newtype SpagoDhallJson _ -spagoDhallJsonCodec :: JsonCodec SpagoDhallJson -spagoDhallJsonCodec = Profunctor.dimap toRep fromRep $ CA.Record.object "SpagoDhallJson" - { license: CA.Record.optional CA.Common.nonEmptyString - , dependencies: CA.Record.optional (CA.array (Profunctor.wrapIso RawPackageName CA.string)) - , packages: CA.Record.optional packageVersionMapCodec +spagoDhallJsonCodec :: CJ.Codec SpagoDhallJson +spagoDhallJsonCodec = Profunctor.dimap toRep fromRep $ CJ.named "SpagoDhallJson" $ CJ.Record.object + { license: CJ.Record.optional CJ.Common.nonEmptyString + , dependencies: CJ.Record.optional (CJ.array (Profunctor.wrapIso RawPackageName CJ.string)) + , packages: CJ.Record.optional packageVersionMapCodec } where - packageVersionMapCodec :: JsonCodec (Map RawPackageName { version :: RawVersion }) - packageVersionMapCodec = rawPackageNameMapCodec $ CA.Record.object "VersionObject" { version: rawVersionCodec } + packageVersionMapCodec :: CJ.Codec (Map RawPackageName { version :: RawVersion }) + packageVersionMapCodec = rawPackageNameMapCodec $ CJ.named "VersionObject" $ CJ.Record.object { version: rawVersionCodec } toRep (SpagoDhallJson fields) = fields { dependencies = if Array.null fields.dependencies then Nothing else Just fields.dependencies @@ -346,8 +348,8 @@ fetchSpagoDhallJson address ref = Run.Except.runExceptAt _spagoDhallError do dhallJson <- Run.liftAff $ dhallToJson { dhall: spagoDhall, cwd: Just tmp } Run.Except.rethrowAt _spagoDhallError $ case dhallJson of Left err -> Left $ Octokit.DecodeError err - Right json -> case CA.decode spagoDhallJsonCodec json of - Left err -> Left $ Octokit.DecodeError $ CA.printJsonDecodeError err + Right json -> case CJ.decode spagoDhallJsonCodec json of + Left err -> Left $ Octokit.DecodeError $ CJ.DecodeError.print err Right value -> pure value where _spagoDhallError :: Proxy "spagoDhallError" @@ -355,7 +357,7 @@ fetchSpagoDhallJson address ref = Run.Except.runExceptAt _spagoDhallError do -- | Convert a string representing a Dhall expression into JSON using the -- | `dhall-to-json` CLI. - dhallToJson :: { dhall :: String, cwd :: Maybe FilePath } -> Aff (Either String Json) + dhallToJson :: { dhall :: String, cwd :: Maybe FilePath } -> Aff (Either String JSON) dhallToJson { dhall, cwd } = do let cmd = "dhall-to-json" let args = [] @@ -363,7 +365,7 @@ fetchSpagoDhallJson address ref = Run.Except.runExceptAt _spagoDhallError do for_ process.stdin \{ writeUtf8End } -> writeUtf8End dhall result <- process.getResult pure case result.exit of - Normally 0 -> lmap CA.printJsonDecodeError $ parseJson CA.json result.stdout + Normally 0 -> lmap CJ.DecodeError.print $ parseJson CJ.json result.stdout _ -> Left result.stderr newtype Bowerfile = Bowerfile @@ -375,24 +377,25 @@ newtype Bowerfile = Bowerfile derive instance Newtype Bowerfile _ derive newtype instance Eq Bowerfile -bowerfileCodec :: JsonCodec Bowerfile -bowerfileCodec = Profunctor.dimap toRep fromRep $ CA.Record.object "Bowerfile" - { description: CA.Record.optional CA.string - , dependencies: CA.Record.optional dependenciesCodec - , license: CA.Record.optional licenseCodec +bowerfileCodec :: CJ.Codec Bowerfile +bowerfileCodec = Profunctor.dimap toRep fromRep $ CJ.named "Bowerfile" $ CJ.Record.object + { description: CJ.Record.optional CJ.string + , dependencies: CJ.Record.optional dependenciesCodec + , license: CJ.Record.optional licenseCodec } where toRep (Bowerfile fields) = fields { dependencies = Just fields.dependencies, license = Just fields.license } fromRep fields = Bowerfile $ fields { dependencies = fromMaybe Map.empty fields.dependencies, license = fromMaybe [] fields.license } - dependenciesCodec :: JsonCodec (Map RawPackageName RawVersionRange) + dependenciesCodec :: CJ.Codec (Map RawPackageName RawVersionRange) dependenciesCodec = rawPackageNameMapCodec rawVersionRangeCodec - licenseCodec :: JsonCodec (Array String) - licenseCodec = CA.codec' decode encode + licenseCodec :: CJ.Codec (Array String) + licenseCodec = Codec.codec' decode encode where - decode json = CA.decode (CA.array CA.string) json <|> map Array.singleton (CA.decode CA.string json) - encode = CA.encode (CA.array CA.string) + encode = CJ.encode (CJ.array CJ.string) + decode json = Codec.decode (CJ.array CJ.string) json + <|> map Array.singleton (Codec.decode CJ.string json) -- | Attempt to construct a Bowerfile from a bower.json file located in a -- | remote repository at the given ref. @@ -491,7 +494,7 @@ instance MemoryEncodable LegacyCache where instance FsEncodable LegacyCache where encodeFs = case _ of LegacySet (RawVersion ref) next -> - Exists.mkExists $ AsJson ("LegacySet__" <> ref) (CA.Common.either Octokit.githubErrorCodec legacyPackageSetCodec) next + Exists.mkExists $ AsJson ("LegacySet__" <> ref) (CJ.Common.either Octokit.githubErrorCodec legacyPackageSetCodec) next LegacyUnion hash next -> Exists.mkExists $ AsJson ("LegacyUnion" <> Sha256.print hash) legacyPackageSetUnionCodec next diff --git a/app/src/App/Legacy/PackageSet.purs b/app/src/App/Legacy/PackageSet.purs index a48812f01..eb1ce8021 100644 --- a/app/src/App/Legacy/PackageSet.purs +++ b/app/src/App/Legacy/PackageSet.purs @@ -14,9 +14,11 @@ module Registry.App.Legacy.PackageSet import Registry.App.Prelude +import Codec.JSON.DecodeError as CJ.DecodeError import Control.Monad.Error.Class as Error import Data.Array as Array -import Data.Codec.Argonaut as CA +import Data.Codec as Codec +import Data.Codec.JSON as CJ import Data.Compactable (separate) import Data.DateTime (Date, DateTime(..)) import Data.DateTime as DateTime @@ -58,15 +60,15 @@ derive instance Newtype PscTag _ derive instance Eq PscTag derive instance Ord PscTag -pscTagCodec :: JsonCodec PscTag -pscTagCodec = CA.codec' decode encode +pscTagCodec :: CJ.Codec PscTag +pscTagCodec = CJ.named "PscTag" $ Codec.codec' decode encode where decode json = do - tagStr <- CA.decode CA.string json - lmap (CA.Named "PscTag" <<< CA.TypeMismatch) (parsePscTag tagStr) + tagStr <- Codec.decode CJ.string json + except $ lmap CJ.DecodeError.basic $ parsePscTag tagStr encode = - CA.encode CA.string <<< printPscTag + CJ.encode CJ.string <<< printPscTag pscDateFormat :: List FormatterCommand pscDateFormat = YearFull : MonthTwoDigits : DayOfMonthTwoDigits : Nil @@ -210,7 +212,7 @@ printDhall (LegacyPackageSet entries) = do type LatestCompatibleSets = Map Version PscTag -latestCompatibleSetsCodec :: JsonCodec LatestCompatibleSets +latestCompatibleSetsCodec :: CJ.Codec LatestCompatibleSets latestCompatibleSetsCodec = Internal.Codec.versionMap pscTagCodec -- | Filter the package sets to only those published before the registry was diff --git a/app/src/App/Legacy/Types.purs b/app/src/App/Legacy/Types.purs index 84de3e3fa..9ed8a6ec8 100644 --- a/app/src/App/Legacy/Types.purs +++ b/app/src/App/Legacy/Types.purs @@ -2,8 +2,8 @@ module Registry.App.Legacy.Types where import Registry.App.Prelude -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Record as CA.Record +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Record as CJ.Record import Data.Profunctor as Profunctor import Registry.Internal.Codec as Internal.Codec import Registry.PackageName as PackageName @@ -14,7 +14,7 @@ newtype LegacyPackageSet = LegacyPackageSet (Map PackageName LegacyPackageSetEnt derive instance Newtype LegacyPackageSet _ derive newtype instance Eq LegacyPackageSet -legacyPackageSetCodec :: JsonCodec LegacyPackageSet +legacyPackageSetCodec :: CJ.Codec LegacyPackageSet legacyPackageSetCodec = Profunctor.wrapIso LegacyPackageSet $ Internal.Codec.packageMap legacyPackageSetEntryCodec @@ -23,12 +23,13 @@ legacyPackageSetCodec = -- | versions they have in the package sets. type LegacyPackageSetUnion = Map PackageName (Map RawVersion (Map PackageName { min :: RawVersion, max :: RawVersion })) -legacyPackageSetUnionCodec :: JsonCodec LegacyPackageSetUnion -legacyPackageSetUnionCodec = Internal.Codec.packageMap $ rawVersionMapCodec $ Internal.Codec.packageMap $ - CA.Record.object "LenientBounds" - { min: rawVersionCodec - , max: rawVersionCodec - } +legacyPackageSetUnionCodec :: CJ.Codec LegacyPackageSetUnion +legacyPackageSetUnionCodec = Internal.Codec.packageMap $ rawVersionMapCodec $ Internal.Codec.packageMap + $ CJ.named "LenientBounds" + $ CJ.Record.object + { min: rawVersionCodec + , max: rawVersionCodec + } -- | The format of a legacy packages.json package set entry for an individual -- | package. @@ -38,11 +39,11 @@ type LegacyPackageSetEntry = , version :: RawVersion } -legacyPackageSetEntryCodec :: JsonCodec LegacyPackageSetEntry -legacyPackageSetEntryCodec = CA.Record.object "LegacyPackageSetEntry" - { dependencies: CA.array PackageName.codec - , repo: CA.string - , version: Profunctor.wrapIso RawVersion CA.string +legacyPackageSetEntryCodec :: CJ.Codec LegacyPackageSetEntry +legacyPackageSetEntryCodec = CJ.named "LegacyPackageSetEntry" $ CJ.Record.object + { dependencies: CJ.array PackageName.codec + , repo: CJ.string + , version: Profunctor.wrapIso RawVersion CJ.string } -- | An unprocessed package name, which may possibly be malformed. @@ -52,11 +53,11 @@ derive instance Newtype RawPackageName _ derive newtype instance Eq RawPackageName derive newtype instance Ord RawPackageName -rawPackageNameCodec :: JsonCodec RawPackageName -rawPackageNameCodec = Profunctor.wrapIso RawPackageName CA.string +rawPackageNameCodec :: CJ.Codec RawPackageName +rawPackageNameCodec = Profunctor.wrapIso RawPackageName CJ.string -rawPackageNameMapCodec :: forall a. JsonCodec a -> JsonCodec (Map RawPackageName a) -rawPackageNameMapCodec = Internal.Codec.strMap "RawPackageMap" (Just <<< RawPackageName) (un RawPackageName) +rawPackageNameMapCodec :: forall a. CJ.Codec a -> CJ.Codec (Map RawPackageName a) +rawPackageNameMapCodec = Internal.Codec.strMap "RawPackageMap" (Right <<< RawPackageName) (un RawPackageName) -- | An unprocessed version newtype RawVersion = RawVersion String @@ -65,11 +66,11 @@ derive instance Newtype RawVersion _ derive newtype instance Eq RawVersion derive newtype instance Ord RawVersion -rawVersionCodec :: JsonCodec RawVersion -rawVersionCodec = Profunctor.wrapIso RawVersion CA.string +rawVersionCodec :: CJ.Codec RawVersion +rawVersionCodec = Profunctor.wrapIso RawVersion CJ.string -rawVersionMapCodec :: forall a. JsonCodec a -> JsonCodec (Map RawVersion a) -rawVersionMapCodec = Internal.Codec.strMap "RawVersionMap" (Just <<< RawVersion) (un RawVersion) +rawVersionMapCodec :: forall a. CJ.Codec a -> CJ.Codec (Map RawVersion a) +rawVersionMapCodec = Internal.Codec.strMap "RawVersionMap" (Right <<< RawVersion) (un RawVersion) -- | An unprocessed version range newtype RawVersionRange = RawVersionRange String @@ -78,5 +79,5 @@ derive instance Newtype RawVersionRange _ derive newtype instance Eq RawVersionRange derive newtype instance Ord RawVersionRange -rawVersionRangeCodec :: JsonCodec RawVersionRange -rawVersionRangeCodec = Profunctor.wrapIso RawVersionRange CA.string +rawVersionRangeCodec :: CJ.Codec RawVersionRange +rawVersionRangeCodec = Profunctor.wrapIso RawVersionRange CJ.string diff --git a/app/src/App/Manifest/SpagoYaml.purs b/app/src/App/Manifest/SpagoYaml.purs index 58c67874b..1d701e57c 100644 --- a/app/src/App/Manifest/SpagoYaml.purs +++ b/app/src/App/Manifest/SpagoYaml.purs @@ -4,12 +4,13 @@ module Registry.App.Manifest.SpagoYaml where import Registry.App.Prelude +import Codec.JSON.DecodeError as CJ.DecodeError 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.Codec as Codec +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Common as CJ.Common +import Data.Codec.JSON.Record as CJ.Record import Data.Map as Map import Data.Profunctor as Profunctor import Data.Set as Set @@ -55,9 +56,9 @@ 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 +spagoYamlCodec :: CJ.Codec SpagoYaml +spagoYamlCodec = CJ.named "SpagoYaml" $ CJ.Record.object + { package: CJ.Record.optional packageConfigCodec } type PackageConfig = @@ -67,12 +68,12 @@ type PackageConfig = , publish :: Maybe PublishConfig } -packageConfigCodec :: JsonCodec PackageConfig -packageConfigCodec = CA.Record.object "PackageConfig" +packageConfigCodec :: CJ.Codec PackageConfig +packageConfigCodec = CJ.named "PackageConfig" $ CJ.Record.object { name: PackageName.codec - , description: CA.Record.optional CA.string + , description: CJ.Record.optional CJ.string , dependencies: dependenciesCodec - , publish: CA.Record.optional publishConfigCodec + , publish: CJ.Record.optional publishConfigCodec } type PublishConfig = @@ -84,18 +85,18 @@ type PublishConfig = , owners :: Maybe (NonEmptyArray Owner) } -publishConfigCodec :: JsonCodec PublishConfig -publishConfigCodec = CA.Record.object "PublishConfig" +publishConfigCodec :: CJ.Codec PublishConfig +publishConfigCodec = CJ.named "PublishConfig" $ CJ.Record.object { 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) + , location: CJ.Record.optional Location.codec + , include: CJ.Record.optional (CJ.array CJ.string) + , exclude: CJ.Record.optional (CJ.array CJ.string) + , owners: CJ.Record.optional (CJ.Common.nonEmptyArray Owner.codec) } -dependenciesCodec :: JsonCodec (Map PackageName (Maybe SpagoRange)) -dependenciesCodec = Profunctor.dimap toJsonRep fromJsonRep $ CA.array dependencyCodec +dependenciesCodec :: CJ.Codec (Map PackageName (Maybe SpagoRange)) +dependenciesCodec = Profunctor.dimap toJsonRep fromJsonRep $ CJ.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), @@ -110,27 +111,27 @@ dependenciesCodec = Profunctor.dimap toJsonRep fromJsonRep $ CA.array dependency -- 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 + singletonCodec :: CJ.Codec (Tuple PackageName SpagoRange) + singletonCodec = Codec.codec' decode encode where - encode (Tuple name range) = CA.encode (Internal.Codec.packageMap spagoRangeCodec) (Map.singleton name range) + encode (Tuple name range) = CJ.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 + singleton <- Codec.decode (Internal.Codec.packageMap spagoRangeCodec) json + except 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." + [] -> Left $ CJ.DecodeError.basic "Expected a singleton map but received an empty one" + xs -> Left $ CJ.DecodeError.basic $ "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 + dependencyCodec :: CJ.Codec (Either PackageName (Tuple PackageName SpagoRange)) + dependencyCodec = Codec.codec' decode encode where encode = case _ of - Left name -> CA.encode PackageName.codec name - Right tuple -> CA.encode singletonCodec tuple + Left name -> CJ.encode PackageName.codec name + Right tuple -> CJ.encode singletonCodec tuple decode json = - map Left (CA.decode PackageName.codec json) - <|> map Right (CA.decode singletonCodec json) + map Left (Codec.decode PackageName.codec json) + <|> map Right (Codec.decode singletonCodec json) convertSpagoDependencies :: Map PackageName (Maybe SpagoRange) -> Either (Set PackageName) (Map PackageName Range) convertSpagoDependencies dependencies = do @@ -162,8 +163,8 @@ printSpagoRange = case _ of Unbounded -> "*" Bounded range -> Range.print range -spagoRangeCodec :: JsonCodec SpagoRange -spagoRangeCodec = CA.codec' decode encode +spagoRangeCodec :: CJ.Codec SpagoRange +spagoRangeCodec = CJ.named "SpagoRange" $ Codec.codec' decode encode where - encode = CA.encode CA.string <<< printSpagoRange - decode = CA.decode CA.string >=> parseSpagoRange >>> lmap (append "SpagoRange: " >>> CA.TypeMismatch) + encode = CJ.encode CJ.string <<< printSpagoRange + decode = Codec.decode CJ.string >=> (parseSpagoRange >>> lmap CJ.DecodeError.basic >>> except) diff --git a/app/src/App/Prelude.purs b/app/src/App/Prelude.purs index 442ab8c01..311a15aa5 100644 --- a/app/src/App/Prelude.purs +++ b/app/src/App/Prelude.purs @@ -39,20 +39,17 @@ module Registry.App.Prelude import Prelude +import Codec.JSON.DecodeError as CJ.DecodeError import Control.Alt ((<|>)) as Extra import Control.Alternative (guard) as Extra -import Control.Monad.Except (ExceptT(..)) as Extra +import Control.Monad.Except (Except, ExceptT(..), except) as Extra import Control.Monad.Trans.Class (lift) as Extra import Control.Parallel.Class as Parallel -import Data.Argonaut.Core (Json) as Extra -import Data.Argonaut.Core as Argonaut -import Data.Argonaut.Parser as Argonaut.Parser import Data.Array as Array import Data.Array.NonEmpty (NonEmptyArray) as Extra import Data.Bifunctor (bimap, lmap) as Extra import Data.Bitraversable (ltraverse) as Extra -import Data.Codec.Argonaut (JsonCodec, JsonDecodeError) as Extra -import Data.Codec.Argonaut as CA +import Data.Codec.JSON as CJ import Data.DateTime (DateTime) import Data.DateTime as DateTime import Data.Either (Either(..), either, fromLeft, fromRight', hush, isRight, note) as Either @@ -83,6 +80,8 @@ import Effect.Class (class MonadEffect, liftEffect) as Extra import Effect.Now as Now import Effect.Ref (Ref) as Extra import Foreign.Object (Object) as Extra +import JSON (JSON) as Extra +import JSON as JSON import Node.Buffer (Buffer) as Extra import Node.Encoding (Encoding(..)) as Extra import Node.FS.Aff as FS.Aff @@ -114,35 +113,35 @@ pacchettibottiKeyType :: String pacchettibottiKeyType = "ssh-ed25519" -- | Print a type as a formatted JSON string -printJson :: forall a. Extra.JsonCodec a -> a -> String -printJson codec = Argonaut.stringifyWithIndent 2 <<< CA.encode codec +printJson :: forall a. CJ.Codec a -> a -> String +printJson codec = JSON.printIndented <<< CJ.encode codec -- | Print a type as a JSON string without formatting -stringifyJson :: forall a. Extra.JsonCodec a -> a -> String -stringifyJson codec = Argonaut.stringify <<< CA.encode codec +stringifyJson :: forall a. CJ.Codec a -> a -> String +stringifyJson codec = JSON.print <<< CJ.encode codec -- | Parse a type from a string of JSON data. -parseJson :: forall a. Extra.JsonCodec a -> String -> Either.Either Extra.JsonDecodeError a -parseJson codec = CA.decode codec <=< Extra.lmap (\err -> CA.TypeMismatch ("JSON: " <> err)) <<< Argonaut.Parser.jsonParser +parseJson :: forall a. CJ.Codec a -> String -> Either.Either CJ.DecodeError a +parseJson codec = CJ.decode codec <=< Extra.lmap (CJ.DecodeError.basic <<< append "JSON: ") <<< JSON.parse -- | Encode data as formatted JSON and write it to the provided filepath -writeJsonFile :: forall a. Extra.JsonCodec a -> Extra.FilePath -> a -> Extra.Aff Unit +writeJsonFile :: forall a. CJ.Codec a -> Extra.FilePath -> a -> Extra.Aff Unit writeJsonFile codec path = FS.Aff.writeTextFile Extra.UTF8 path <<< (_ <> "\n") <<< printJson codec -- | Decode data from a JSON file at the provided filepath -readJsonFile :: forall a. Extra.JsonCodec a -> Extra.FilePath -> Extra.Aff (Either.Either String a) +readJsonFile :: forall a. CJ.Codec a -> Extra.FilePath -> Extra.Aff (Either.Either String a) 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) + pure (Extra.lmap Aff.message result >>= parseJson codec >>> Extra.lmap CJ.DecodeError.print) -- | 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 :: forall a. CJ.Codec 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) + Extra.lmap CJ.DecodeError.print (CJ.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 :: forall a. CJ.Codec 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) diff --git a/app/src/App/Server.purs b/app/src/App/Server.purs index 46e2b00b5..659b4ad8a 100644 --- a/app/src/App/Server.purs +++ b/app/src/App/Server.purs @@ -3,7 +3,7 @@ module Registry.App.Server where import Registry.App.Prelude hiding ((/)) import Control.Monad.Cont (ContT) -import Data.Codec.Argonaut as CA +import Data.Codec.JSON as CJ import Data.Formatter.DateTime as Formatter.DateTime import Data.Newtype (unwrap) import Data.String as String @@ -91,7 +91,7 @@ router env { route, method, body } = HTTPurple.usingCont case route, method of HTTPurple.badRequest "Expected transfer operation." Jobs, Get -> do - jsonOk (CA.array V1.jobCodec) [] + jsonOk (CJ.array V1.jobCodec) [] Job jobId { level: maybeLogLevel, since }, Get -> do let logLevel = fromMaybe Error maybeLogLevel @@ -291,13 +291,13 @@ main = do , " └───────────────────────────────────────────┘" ] -jsonDecoder :: forall a. JsonCodec a -> JsonDecoder JsonDecodeError a +jsonDecoder :: forall a. CJ.Codec a -> JsonDecoder CJ.DecodeError a jsonDecoder codec = JsonDecoder (parseJson codec) -jsonEncoder :: forall a. JsonCodec a -> JsonEncoder a +jsonEncoder :: forall a. CJ.Codec a -> JsonEncoder a jsonEncoder codec = JsonEncoder (stringifyJson codec) -jsonOk :: forall m a. MonadAff m => JsonCodec a -> a -> m Response +jsonOk :: forall m a. MonadAff m => CJ.Codec a -> a -> m Response jsonOk codec datum = HTTPurple.ok' HTTPurple.jsonHeaders $ HTTPurple.toJson (jsonEncoder codec) datum runEffects :: forall a. ServerEnv -> Run ServerEffects a -> Aff (Either Aff.Error a) diff --git a/app/test/App/CLI/Purs.purs b/app/test/App/CLI/Purs.purs index d3add8698..99ff25951 100644 --- a/app/test/App/CLI/Purs.purs +++ b/app/test/App/CLI/Purs.purs @@ -2,10 +2,11 @@ module Test.Registry.App.CLI.Purs (spec) where import Registry.App.Prelude -import Data.Argonaut.Parser as Argonaut.Parser -import Data.Codec.Argonaut as CA +import Codec.JSON.DecodeError as CJ.DecodeError +import Data.Codec.JSON as CJ import Data.Foldable (traverse_) import Data.Map as Map +import JSON as JSON import Node.FS.Aff as FS.Aff import Node.Path as Path import Registry.App.CLI.Purs (CompilerFailure(..)) @@ -69,10 +70,10 @@ spec = do CompilationError errs -> Purs.printCompilerErrors errs UnknownError str -> str MissingCompiler -> "MissingCompiler" - Right str -> case Argonaut.Parser.jsonParser str of + Right str -> case JSON.parse str of Left parseErr -> Assert.fail $ "Failed to parse output as JSON: " <> parseErr - Right json -> case CA.decode PursGraph.pursGraphCodec json of - Left decodeErr -> Assert.fail $ "Failed to decode JSON: " <> CA.printJsonDecodeError decodeErr + Right json -> case CJ.decode PursGraph.pursGraphCodec json of + Left decodeErr -> Assert.fail $ "Failed to decode JSON: " <> CJ.DecodeError.print decodeErr Right graph -> do let expected = Map.fromFoldable diff --git a/app/test/App/GitHubIssue.purs b/app/test/App/GitHubIssue.purs index 624a0d8b4..70b3ccb3a 100644 --- a/app/test/App/GitHubIssue.purs +++ b/app/test/App/GitHubIssue.purs @@ -4,9 +4,10 @@ module Test.Registry.App.GitHubIssue import Registry.App.Prelude -import Data.Argonaut.Parser as Argonaut.Parser -import Data.Codec.Argonaut as CA +import Codec.JSON.DecodeError as CJ.DecodeError +import Data.Codec.JSON as CJ import Data.Map as Map +import JSON as JSON import Node.Path as Path import Registry.App.GitHubIssue as GitHubIssue import Registry.Foreign.Octokit (IssueNumber(..)) @@ -81,10 +82,18 @@ decodeEventsToOps = do rawOperation = preludeAdditionString - parseJson = bimap CA.printJsonDecodeError Publish <<< CA.decode Operation.publishCodec <=< Argonaut.Parser.jsonParser + parseJson = bimap CJ.DecodeError.print Publish <<< CJ.decode Operation.publishCodec <=< JSON.parse parseJson (GitHubIssue.firstObject rawOperation) `Assert.shouldEqual` (Right operation) + Spec.it "returns a sensible error message when the JSON fails to parse" do + let + rawOperation = packageNameTooLongString + + parseJson = bimap CJ.DecodeError.print Publish <<< CJ.decode Operation.publishCodec <=< JSON.parse + + parseJson (GitHubIssue.firstObject rawOperation) `Assert.shouldEqual` (Left "$.name: Could not decode Publish:\n Could not decode PackageName:\n Package name cannot be longer than 150 characters") + preludeAdditionString :: String preludeAdditionString = """ @@ -104,3 +113,19 @@ preludeAdditionString = Thanks! """ + +packageNameTooLongString :: String +packageNameTooLongString = + """ + ``` + { + "name": "packagenamewayyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyytoolong", + "ref": "v5.0.0", + "location": { + "githubOwner": "purescript", + "githubRepo": "purescript-prelude" + }, + "compiler": "0.15.0" + } + ``` + """ diff --git a/app/test/App/Legacy/Manifest.purs b/app/test/App/Legacy/Manifest.purs index ccf40eb36..35fecc725 100644 --- a/app/test/App/Legacy/Manifest.purs +++ b/app/test/App/Legacy/Manifest.purs @@ -2,8 +2,8 @@ module Test.Registry.App.Legacy.Manifest (spec) where import Registry.App.Prelude +import Codec.JSON.DecodeError as CJ.DecodeError import Data.Array as Array -import Data.Codec.Argonaut as CA import Registry.App.Legacy.Manifest as Legacy.Manifest import Registry.Test.Assert as Assert import Test.Spec (Spec) @@ -24,7 +24,7 @@ bowerfileSpec = do [ "Failed to parse:\n" , input , "due to an error:\n" - , CA.printJsonDecodeError err + , CJ.DecodeError.print err ] Right _ -> pure unit diff --git a/foreign/spago.yaml b/foreign/spago.yaml index 9f325e621..7dd5afdbb 100644 --- a/foreign/spago.yaml +++ b/foreign/spago.yaml @@ -6,15 +6,16 @@ package: dependencies: - aff - aff-promise - - argonaut-core - arrays - b64 - bifunctors - - codec-argonaut + - codec + - codec-json - convertable-options - datetime - effect - either + - exceptions - fetch - filterable - foldable-traversable @@ -23,6 +24,8 @@ package: - http-methods - integers - js-date + - js-fetch + - json - maybe - newtype - node-buffer @@ -33,12 +36,15 @@ package: - profunctor - registry-lib - strings + - transformers - tuples - unsafe-coerce - variant test: main: Test.Foreign dependencies: + - node-child-process + - node-execa - node-fs - node-process - spec diff --git a/foreign/src/Foreign/Octokit.purs b/foreign/src/Foreign/Octokit.purs index a826cf5b4..c0258b096 100644 --- a/foreign/src/Foreign/Octokit.purs +++ b/foreign/src/Foreign/Octokit.purs @@ -19,6 +19,7 @@ module Registry.Foreign.Octokit , Tag , Team , TeamMember + , atKey , closeIssueRequest , createCommentRequest , decodeBase64Content @@ -40,15 +41,16 @@ module Registry.Foreign.Octokit import Prelude +import Codec.JSON.DecodeError as CJ.DecodeError +import Control.Monad.Except (except) import Control.Promise (Promise) import Control.Promise as Promise -import Data.Argonaut.Core (Json) import Data.Array as Array import Data.Bifunctor (lmap) -import Data.Codec.Argonaut (JsonCodec, JsonDecodeError) -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Record as CA.Record -import Data.Codec.Argonaut.Variant as CA.Variant +import Data.Codec as Codec +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Record as CJ.Record +import Data.Codec.JSON.Variant as CJ.Variant import Data.DateTime (DateTime) import Data.DateTime.Instant (Instant) import Data.DateTime.Instant as Instant @@ -72,6 +74,10 @@ import Effect.Class (class MonadEffect, liftEffect) import Effect.Uncurried (EffectFn2, EffectFn6, runEffectFn2, runEffectFn6) import Foreign.Object (Object) import Foreign.Object as Object +import JSON (JSON) +import JSON as JSON +import JSON.Object as JSON.Object +import JSON.Path as JSON.Path import Node.Path (FilePath) import Registry.Internal.Codec as Internal.Codec import Type.Proxy (Proxy(..)) @@ -128,7 +134,7 @@ listTeamMembersRequest team = , headers: Object.empty , args: noArgs , paginate: true - , codec: CA.array $ CA.Record.object "TeamMember" { login: CA.string, id: CA.int } + , codec: CJ.array $ CJ.named "TeamMember" $ CJ.Record.object { login: CJ.string, id: CJ.int } } type Tag = { name :: String, sha :: String, url :: String } @@ -141,9 +147,9 @@ listTagsRequest address = , headers: Object.empty , args: noArgs , paginate: true - , codec: CA.array $ Profunctor.dimap toJsonRep fromJsonRep $ CA.Record.object "Tag" - { name: CA.string - , commit: CA.Record.object "Tag.Commit" { sha: CA.string, url: CA.string } + , codec: CJ.array $ Profunctor.dimap toJsonRep fromJsonRep $ CJ.named "Tag" $ CJ.Record.object + { name: CJ.string + , commit: CJ.Record.object { sha: CJ.string, url: CJ.string } } } where @@ -159,19 +165,22 @@ getContentRequest { address, ref, path } = , headers: Object.empty , args: noArgs , paginate: false - , codec: Profunctor.dimap toJsonRep fromJsonRep $ CA.Record.object "Content" - { data: CA.Record.object "Content.data" + , codec: Profunctor.dimap toJsonRep fromJsonRep $ CJ.named "Content" $ CJ.Record.object + { data: CJ.Record.object { type: value "file" , encoding: value "base64" - , content: CA.string + , content: CJ.string } } } where - value :: String -> JsonCodec String - value expected = CA.codec' - (\json -> CA.decode CA.string json >>= \decoded -> if decoded == expected then pure expected else Left (CA.UnexpectedValue json)) - (\_ -> CA.encode CA.string expected) + value :: String -> CJ.Codec String + value expected = Codec.codec' + ( \json -> except $ CJ.decode CJ.string json >>= \decoded -> case decoded == expected of + true -> pure expected + false -> Left (CJ.DecodeError.basic $ "Unexpected JSON value (expecting '" <> expected <> "'): " <> JSON.print json) + ) + (\_ -> CJ.encode CJ.string expected) toJsonRep (Base64Content str) = { data: { type: "file", encoding: "base64", content: str } } fromJsonRep { data: { content } } = Base64Content content @@ -184,7 +193,7 @@ getRefCommitRequest { address, ref } = , headers: Object.empty , args: noArgs , paginate: false - , codec: Profunctor.dimap toJsonRep fromJsonRep $ CA.Record.object "Ref" { object: CA.Record.object "Ref.object" { sha: CA.string } } + , codec: Profunctor.dimap toJsonRep fromJsonRep $ CJ.named "Ref" $ CJ.Record.object { object: CJ.Record.object { sha: CJ.string } } } where toJsonRep sha = { object: { sha } } @@ -198,8 +207,8 @@ getCommitDateRequest { address, commitSha } = , headers: Object.empty , args: noArgs , paginate: false - , codec: Profunctor.dimap toJsonRep fromJsonRep $ CA.Record.object "Commit" - { committer: CA.Record.object "Commit.committer" { date: Internal.Codec.iso8601DateTime } } + , codec: Profunctor.dimap toJsonRep fromJsonRep $ CJ.named "Commit" $ CJ.Record.object + { committer: CJ.Record.object { date: Internal.Codec.iso8601DateTime } } } where toJsonRep date = { committer: { date } } @@ -213,7 +222,7 @@ createCommentRequest { address, issue: IssueNumber issue, body } = , headers: Object.empty , args: unsafeToJSArgs { body } , paginate: false - , codec: CA.codec' (\_ -> pure unit) (CA.encode CA.null) + , codec: Codec.codec' (\_ -> pure unit) (CJ.encode CJ.null) } -- | Close an issue. Requires authentication. @@ -224,7 +233,7 @@ closeIssueRequest { address, issue: IssueNumber issue } = , headers: Object.empty , args: unsafeToJSArgs { state: "closed" } , paginate: false - , codec: CA.codec' (\_ -> pure unit) (CA.encode CA.null) + , codec: Codec.codec' (\_ -> pure unit) (CJ.encode CJ.null) } type RateLimit = @@ -239,13 +248,13 @@ rateLimitRequest = , headers: Object.empty , args: noArgs , paginate: false - , codec: Profunctor.dimap toJsonRep fromJsonRep $ CA.Record.object "RateLimit" - { data: CA.Record.object "RateLimit.data" - { resources: CA.Record.object "RateLimit.data.resources" - { core: CA.Record.object "RateLimit.data.resources.core" - { limit: CA.int - , remaining: CA.int - , reset: CA.number + , codec: Profunctor.dimap toJsonRep fromJsonRep $ CJ.named "RateLimit" $ CJ.Record.object + { data: CJ.Record.object + { resources: CJ.Record.object + { core: CJ.Record.object + { limit: CJ.int + , remaining: CJ.int + , reset: CJ.number } } } @@ -292,11 +301,11 @@ type Request a = , headers :: Object String , args :: JSArgs , paginate :: Boolean - , codec :: JsonCodec a + , codec :: CJ.Codec a } -foreign import requestImpl :: forall r. EffectFn6 Octokit String (Object String) JSArgs (Object Json -> r) (Json -> r) (Promise r) -foreign import paginateImpl :: forall r. EffectFn6 Octokit String (Object String) JSArgs (Object Json -> r) (Json -> r) (Promise r) +foreign import requestImpl :: forall r. EffectFn6 Octokit String (Object String) JSArgs (Object JSON -> r) (JSON -> r) (Promise r) +foreign import paginateImpl :: forall r. EffectFn6 Octokit String (Object String) JSArgs (Object JSON -> r) (JSON -> r) (Promise r) -- | Make a request to the GitHub API -- @@ -309,16 +318,17 @@ request octokit { route, headers, args, paginate, codec } = do Left githubError -> case decodeGitHubAPIError githubError of Left decodeError -> Left $ UnexpectedError decodeError Right decoded -> Left $ APIError decoded - Right json -> case CA.decode codec json of - Left decodeError -> Left $ DecodeError $ CA.printJsonDecodeError decodeError + Right json -> case CJ.decode codec json of + Left decodeError -> Left $ DecodeError $ CJ.DecodeError.print decodeError Right parsed -> Right parsed where - decodeGitHubAPIError :: Object Json -> Either String GitHubAPIError - decodeGitHubAPIError object = lmap CA.printJsonDecodeError do - statusCode <- atKey "status" CA.int object + decodeGitHubAPIError :: Object JSON -> Either String GitHubAPIError + decodeGitHubAPIError object = lmap CJ.DecodeError.print do + let jObject = JSON.Object.fromFoldableWithIndex object + statusCode <- atKey "status" CJ.int jObject message <- case statusCode of 304 -> pure "" - _ -> atKey "response" CA.jobject object >>= atKey "data" CA.jobject >>= atKey "message" CA.string + _ -> atKey "response" CJ.jobject jObject >>= atKey "data" CJ.jobject >>= atKey "message" CJ.string pure { statusCode, message } type GitHubAPIError = @@ -326,10 +336,10 @@ type GitHubAPIError = , message :: String } -githubApiErrorCodec :: JsonCodec GitHubAPIError -githubApiErrorCodec = CA.Record.object "GitHubAPIError" - { statusCode: CA.int - , message: CA.string +githubApiErrorCodec :: CJ.Codec GitHubAPIError +githubApiErrorCodec = CJ.named "GitHubAPIError" $ CJ.Record.object + { statusCode: CJ.int + , message: CJ.string } data GitHubError @@ -340,11 +350,11 @@ data GitHubError derive instance Eq GitHubError derive instance Ord GitHubError -githubErrorCodec :: JsonCodec GitHubError -githubErrorCodec = Profunctor.dimap toVariant fromVariant $ CA.Variant.variantMatch - { unexpectedError: Right CA.string +githubErrorCodec :: CJ.Codec GitHubError +githubErrorCodec = Profunctor.dimap toVariant fromVariant $ CJ.Variant.variantMatch + { unexpectedError: Right CJ.string , apiError: Right githubApiErrorCodec - , decodeError: Right CA.string + , decodeError: Right CJ.string } where toVariant = case _ of @@ -375,9 +385,9 @@ printGitHubError = case _ of , error ] -atKey :: forall a. String -> JsonCodec a -> Object Json -> Either JsonDecodeError a +atKey :: forall a. String -> CJ.Codec a -> JSON.JObject -> Either CJ.DecodeError a atKey key codec object = Maybe.maybe - (Left (CA.AtKey key CA.MissingValue)) - (lmap (CA.AtKey key) <<< CA.decode codec) - (Object.lookup key object) + (Left $ CJ.DecodeError.noValueFound $ JSON.Path.AtKey key JSON.Path.Tip) + (lmap (CJ.DecodeError.withPath (\p -> JSON.Path.extend p (JSON.Path.AtKey key JSON.Path.Tip))) <<< CJ.decode codec) + (JSON.Object.lookup key object) diff --git a/foreign/src/Foreign/Yaml.purs b/foreign/src/Foreign/Yaml.purs index 958fdb6ba..2d197fd24 100644 --- a/foreign/src/Foreign/Yaml.purs +++ b/foreign/src/Foreign/Yaml.purs @@ -2,13 +2,13 @@ module Registry.Foreign.Yaml ( yamlParser ) where -import Data.Argonaut.Core as Core import Data.Either (Either(..)) import Data.Function.Uncurried (Fn3, runFn3) +import JSON (JSON) -- | Parse a JSON string, constructing the `Toml` value described by the string. -- | To convert a string into a `Toml` string, see `fromString`. -yamlParser :: String -> Either String Core.Json +yamlParser :: String -> Either String JSON yamlParser j = runFn3 yamlDocParserImpl Left Right j -foreign import yamlDocParserImpl :: forall a. Fn3 (String -> a) (Core.Json -> a) String a +foreign import yamlDocParserImpl :: forall a. Fn3 (String -> a) (JSON -> a) String a diff --git a/foreign/test/Foreign/JsonRepair.purs b/foreign/test/Foreign/JsonRepair.purs index 7c6be3714..3439df6b5 100644 --- a/foreign/test/Foreign/JsonRepair.purs +++ b/foreign/test/Foreign/JsonRepair.purs @@ -2,15 +2,14 @@ module Test.Registry.Foreign.JsonRepair (spec) where import Prelude -import Data.Argonaut.Core (Json) -import Data.Argonaut.Core as Argonaut -import Data.Argonaut.Parser as Argonaut.Parser +import Codec.JSON.DecodeError as CJ.DecodeError import Data.Bifunctor (lmap) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Record as CA.Record +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Record as CJ.Record import Data.Either (Either) import Data.Either as Either +import JSON (JSON) +import JSON as JSON import Registry.Foreign.JsonRepair as JsonRepair import Registry.Test.Assert as Assert import Test.Spec as Spec @@ -18,40 +17,40 @@ import Test.Spec as Spec spec :: Spec.Spec Unit spec = do Spec.describe "Valid JSON" do - let arrayCodec = CA.array CA.int - parseTest arrayCodec "[1,2,3]" $ CA.encode arrayCodec [ 1, 2, 3 ] + let arrayCodec = CJ.array CJ.int + parseTest arrayCodec "[1,2,3]" $ CJ.encode arrayCodec [ 1, 2, 3 ] - let objectCodec = CA.Record.object "Test" { name: CA.string } - parseTest objectCodec """{ "name": "test" }""" $ CA.encode objectCodec { name: "test" } + let objectCodec = CJ.named "Test" $ CJ.Record.object { name: CJ.string } + parseTest objectCodec """{ "name": "test" }""" $ CJ.encode objectCodec { name: "test" } let - complexCodec = CA.Record.object "Complex" { complex: CA.Record.object "Nested" { nested: CA.string, bool: CA.boolean } } + complexCodec = CJ.named "Complex" $ CJ.Record.object { complex: CJ.Record.object { nested: CJ.string, bool: CJ.boolean } } complexJson = { complex: { nested: "json", bool: true } } - parseTest complexCodec (Argonaut.stringify $ CA.encode complexCodec complexJson) (CA.encode complexCodec complexJson) + parseTest complexCodec (JSON.print $ CJ.encode complexCodec complexJson) (CJ.encode complexCodec complexJson) Spec.describe "Fixable JSON" do - let testObjectCodec = CA.Record.object "Test" { trailing: CA.string } - parseTest testObjectCodec """{ "trailing": "comma", }""" $ CA.encode testObjectCodec { trailing: "comma" } + let testObjectCodec = CJ.named "Test" $ CJ.Record.object { trailing: CJ.string } + parseTest testObjectCodec """{ "trailing": "comma", }""" $ CJ.encode testObjectCodec { trailing: "comma" } - let testArrayCodec = CA.array CA.string - parseTest testArrayCodec """[ "trailing comma", ]""" $ CA.encode testArrayCodec [ "trailing comma" ] + let testArrayCodec = CJ.array CJ.string + parseTest testArrayCodec """[ "trailing comma", ]""" $ CJ.encode testArrayCodec [ "trailing comma" ] Spec.describe "Unfixable JSON" do let - failParse :: forall a. JsonCodec a -> String -> Spec.Spec Unit + failParse :: forall a. CJ.Codec a -> String -> Spec.Spec Unit failParse codec str = Spec.it str do parseString codec str `Assert.shouldSatisfy` Either.isLeft - failParse (CA.Record.object "Test" { name: CA.string }) "name: test" - failParse (CA.Record.object "Test" { key: CA.string }) """{ "horrendously invalid json" }""" + failParse (CJ.named "Test" $ CJ.Record.object { name: CJ.string }) "name: test" + failParse (CJ.named "Test" $ CJ.Record.object { key: CJ.string }) """{ "horrendously invalid json" }""" -parseString :: forall a. JsonCodec a -> String -> Either String String +parseString :: forall a. CJ.Codec a -> String -> Either String String parseString codec input = do - parsed <- Argonaut.Parser.jsonParser (JsonRepair.tryRepair input) - decoded <- lmap CA.printJsonDecodeError $ CA.decode codec parsed - pure $ Argonaut.stringify $ CA.encode codec decoded + parsed <- JSON.parse (JsonRepair.tryRepair input) + decoded <- lmap CJ.DecodeError.print $ CJ.decode codec parsed + pure $ JSON.print $ CJ.encode codec decoded -parseTest :: forall a. JsonCodec a -> String -> Json -> Spec.Spec Unit +parseTest :: forall a. CJ.Codec a -> String -> JSON -> Spec.Spec Unit parseTest codec str json = Spec.it str do - parseString codec str `Assert.shouldContain` Argonaut.stringify json + parseString codec str `Assert.shouldContain` JSON.print json diff --git a/lib/spago.yaml b/lib/spago.yaml index c550af53f..8349c8a85 100644 --- a/lib/spago.yaml +++ b/lib/spago.yaml @@ -3,12 +3,14 @@ package: publish: license: BSD-3-Clause version: 0.0.1 + build: + pedanticPackages: true dependencies: - aff - - argonaut-core - arrays - bifunctors - - codec-argonaut + - codec + - codec-json - control - datetime - effect @@ -21,6 +23,7 @@ package: - functors - graphs - integers + - json - language-cst-parser - lists - maybe @@ -37,14 +40,15 @@ package: - profunctor-lenses - routing-duplex - safe-coerce + - st - strings - transformers - tuples test: main: Test.Registry dependencies: - - argonaut-core - exceptions + - json - node-child-process - node-execa - spec diff --git a/lib/src/API/V1.purs b/lib/src/API/V1.purs index dcf37d128..a6193b5f7 100644 --- a/lib/src/API/V1.purs +++ b/lib/src/API/V1.purs @@ -2,11 +2,9 @@ module Registry.API.V1 where import Prelude hiding ((/)) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Record as CA.Record -import Data.Codec.Argonaut.Record as CAR -import Data.Codec.Argonaut.Sum as CA.Sum +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Record as CJ.Record +import Data.Codec.JSON.Sum as CJ.Sum import Data.DateTime (DateTime) import Data.Either (Either(..), hush) import Data.Formatter.DateTime as DateTime @@ -63,8 +61,8 @@ timestampP = Routing.as printTimestamp parseTimestamp type JobCreatedResponse = { jobId :: JobId } -jobCreatedResponseCodec :: JsonCodec JobCreatedResponse -jobCreatedResponseCodec = CA.Record.object "JobCreatedResponse" { jobId: jobIdCodec } +jobCreatedResponseCodec :: CJ.Codec JobCreatedResponse +jobCreatedResponseCodec = CJ.named "JobCreatedResponse" $ CJ.Record.object { jobId: jobIdCodec } type Job = { jobId :: JobId @@ -77,24 +75,24 @@ type Job = , logs :: Array LogLine } -jobCodec :: JsonCodec Job -jobCodec = CA.Record.object "Job" +jobCodec :: CJ.Codec Job +jobCodec = CJ.named "Job" $ CJ.Record.object { jobId: jobIdCodec , jobType: jobTypeCodec , packageName: PackageName.codec - , ref: CA.string + , ref: CJ.string , createdAt: Internal.Codec.iso8601DateTime - , finishedAt: CAR.optional Internal.Codec.iso8601DateTime - , success: CA.boolean - , logs: CA.array logLineCodec + , finishedAt: CJ.Record.optional Internal.Codec.iso8601DateTime + , success: CJ.boolean + , logs: CJ.array logLineCodec } newtype JobId = JobId String derive instance Newtype JobId _ -jobIdCodec :: JsonCodec JobId -jobIdCodec = Profunctor.wrapIso JobId CA.string +jobIdCodec :: CJ.Codec JobId +jobIdCodec = Profunctor.wrapIso JobId CJ.string data JobType = PublishJob | UnpublishJob | TransferJob @@ -113,8 +111,8 @@ printJobType = case _ of UnpublishJob -> "unpublish" TransferJob -> "transfer" -jobTypeCodec :: JsonCodec JobType -jobTypeCodec = CA.Sum.enumSum printJobType (hush <<< parseJobType) +jobTypeCodec :: CJ.Codec JobType +jobTypeCodec = CJ.Sum.enumSum printJobType (hush <<< parseJobType) type LogLine = { level :: LogLevel @@ -123,10 +121,10 @@ type LogLine = , timestamp :: DateTime } -logLineCodec :: JsonCodec LogLine -logLineCodec = CA.Record.object "LogLine" - { level: CA.Sum.enumSum printLogLevel (hush <<< parseLogLevel) - , message: CA.string +logLineCodec :: CJ.Codec LogLine +logLineCodec = CJ.named "LogLine" $ CJ.Record.object + { level: CJ.Sum.enumSum printLogLevel (hush <<< parseLogLevel) + , message: CJ.string , jobId: jobIdCodec , timestamp: Internal.Codec.iso8601DateTime } diff --git a/lib/src/Internal/Codec.purs b/lib/src/Internal/Codec.purs index f7d5acf50..e062a4414 100644 --- a/lib/src/Internal/Codec.purs +++ b/lib/src/Internal/Codec.purs @@ -10,26 +10,28 @@ module Registry.Internal.Codec import Prelude -import Data.Argonaut.Core (Json) +import Codec.JSON.DecodeError as CJ.DecodeError +import Control.Monad.Except (Except, except, withExcept) import Data.Bifunctor (lmap) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA +import Data.Codec as Codec +import Data.Codec.JSON as CJ import Data.DateTime (Date, DateTime) import Data.DateTime as DateTime import Data.Either (Either(..)) -import Data.Either as Either import Data.FoldableWithIndex (forWithIndex_) import Data.Formatter.DateTime as Formatter.DateTime import Data.Formatter.DateTime as Formatter.Datetime import Data.Int as Int import Data.Map (Map) import Data.Map as Map -import Data.Maybe (Maybe) import Data.String as String import Data.Traversable (for) import Data.Tuple (Tuple(..)) import Foreign.Object as Object import Foreign.Object.ST as Object.ST +import JSON (JSON) +import JSON.Object as JSON.Object +import JSON.Path as JSON.Path import Parsing (Parser) import Parsing as Parsing import Registry.Internal.Format as Internal.Format @@ -48,55 +50,55 @@ import Registry.Version as Version -- | be a valid simple ISO8601 string (ie. it may be an outdated metadata file -- | using the RFC3339String format). The string will be modified if you read -- | and then write. -iso8601DateTime :: JsonCodec DateTime -iso8601DateTime = CA.codec' decode encode +iso8601DateTime :: CJ.Codec DateTime +iso8601DateTime = Codec.codec' decode encode where - encode :: DateTime -> Json + encode :: DateTime -> JSON encode = Formatter.DateTime.format Internal.Format.iso8601DateTime - >>> CA.encode CA.string + >>> CJ.encode CJ.string - decode :: Json -> Either CA.JsonDecodeError DateTime + decode :: JSON -> Except CJ.DecodeError DateTime decode json = do - string <- CA.decode CA.string json - case Internal.Format.rfc3339ToISO8601 string of - Left err -> Left $ CA.TypeMismatch $ "Unable to parse input as ISO8601: " <> err + string <- Codec.decode CJ.string json + except case Internal.Format.rfc3339ToISO8601 string of + Left err -> Left $ CJ.DecodeError.basic $ "Unable to parse input as ISO8601: " <> err Right fixed -> - lmap (CA.TypeMismatch <<< append "ISO8601: ") (Formatter.Datetime.unformat Internal.Format.iso8601DateTime fixed) + lmap (CJ.DecodeError.basic <<< append "ISO8601: ") (Formatter.Datetime.unformat Internal.Format.iso8601DateTime fixed) -- | INTERNAL -- | -- | A codec for date times that encode as JSON strings in the ISO8601 date -- | format, ie. YYYY-MM-DD -iso8601Date :: JsonCodec Date -iso8601Date = CA.codec' decode encode +iso8601Date :: CJ.Codec Date +iso8601Date = Codec.codec' decode encode where - encode :: Date -> Json + encode :: Date -> JSON encode = flip DateTime.DateTime bottom >>> Formatter.DateTime.format Internal.Format.iso8601Date - >>> CA.encode CA.string + >>> CJ.encode CJ.string - decode :: Json -> Either CA.JsonDecodeError Date + decode :: JSON -> Except CJ.DecodeError Date decode json = do - string <- CA.decode CA.string json - dateTime <- lmap (CA.TypeMismatch <<< append "YYYY-MM-DD: ") (Formatter.DateTime.unformat Internal.Format.iso8601Date string) + string <- Codec.decode CJ.string json + dateTime <- except $ lmap (CJ.DecodeError.basic <<< append "YYYY-MM-DD: ") (Formatter.DateTime.unformat Internal.Format.iso8601Date string) pure $ DateTime.date dateTime -- | INTERNAL -- | -- | A codec for `String` values with an explicit limited length. -limitedString :: Int -> JsonCodec String -limitedString limit = CA.codec' decode encode +limitedString :: Int -> CJ.Codec String +limitedString limit = Codec.codec' decode encode where - encode :: String -> Json - encode = CA.encode CA.string + encode :: String -> JSON + encode = CJ.encode CJ.string - decode :: Json -> Either CA.JsonDecodeError String - decode json = do - string <- CA.decode CA.string json + decode :: JSON -> Except CJ.DecodeError String + decode json = except do + string <- CJ.decode CJ.string json if String.length string > limit then - Left $ CA.TypeMismatch $ "LimitedString: Exceeds limit of " <> Int.toStringAs Int.decimal limit <> " characters." + Left $ CJ.DecodeError.basic $ "LimitedString: Exceeds limit of " <> Int.toStringAs Int.decimal limit <> " characters." else Right string @@ -104,51 +106,55 @@ limitedString limit = CA.codec' decode encode -- | -- | A codec for `String` values that can be parsed into a `String`, failing -- | with the parse error message if invalid. -parsedString :: String -> Parser String String -> JsonCodec String -parsedString label parser = CA.codec' decode encode +parsedString :: Parser String String -> CJ.Codec String +parsedString parser = Codec.codec' decode encode where - encode :: String -> Json - encode = CA.encode CA.string + encode :: String -> JSON + encode = CJ.encode CJ.string - decode :: Json -> Either CA.JsonDecodeError String - decode json = do - string <- CA.decode CA.string json + decode :: JSON -> Except CJ.DecodeError String + decode json = except do + string <- CJ.decode CJ.string json case Parsing.runParser string parser of - Left error -> Left $ CA.TypeMismatch $ label <> ": " <> Parsing.parseErrorMessage error + Left error -> Left $ CJ.DecodeError.basic $ Parsing.parseErrorMessage error Right value -> pure value -- | INTERNAL -- | -- | A codec for `Map` structures that have `PackageName`s as keys. Encodes as -- | a JSON object, ie. `{ "aff": , "argonaut": }` -packageMap :: forall a. JsonCodec a -> JsonCodec (Map PackageName a) -packageMap = strMap "PackageName" (Either.hush <<< PackageName.parse) PackageName.print +packageMap :: forall a. CJ.Codec a -> CJ.Codec (Map PackageName a) +packageMap = strMap "PackageName" PackageName.parse PackageName.print -- | INTERNAL -- | -- | A codec for `Map` structures that have `Version`s as keys. Encodes as a -- | JSON object, ie. `{ "1.0.0": , "2.0.0": }` -versionMap :: forall a. JsonCodec a -> JsonCodec (Map Version a) -versionMap = strMap "Version" (Either.hush <<< Version.parse) Version.print +versionMap :: forall a. CJ.Codec a -> CJ.Codec (Map Version a) +versionMap = strMap "Version" Version.parse Version.print -- | INTERNAL -- | -- | A codec for `Map` structures that have keys that can be encoded as strings. -- | Represented as an object in JSON. -strMap :: forall k a. Ord k => String -> (String -> Maybe k) -> (k -> String) -> JsonCodec a -> JsonCodec (Map k a) -strMap type_ parse print valueCodec = CA.codec' decode encode +strMap :: forall k a. Ord k => String -> (String -> Either String k) -> (k -> String) -> CJ.Codec a -> CJ.Codec (Map k a) +strMap typeName parse print valueCodec = Codec.codec' decode encode where - encode :: Map k a -> Json - encode m = CA.encode CA.jobject $ Object.runST do + encode :: Map k a -> JSON + encode m = CJ.encode CJ.jobject $ JSON.Object.fromFoldableWithIndex $ Object.runST do obj <- Object.ST.new - forWithIndex_ m \k v -> Object.ST.poke (print k) (CA.encode valueCodec v) obj + forWithIndex_ m \k v -> Object.ST.poke (print k) (CJ.encode valueCodec v) obj pure obj - decode :: Json -> Either CA.JsonDecodeError (Map k a) + decode :: JSON -> Except CJ.DecodeError (Map k a) decode json = do - array :: Array _ <- Object.toUnfoldable <$> CA.decode CA.jobject json + array :: Array _ <- JSON.Object.toUnfoldable <$> Codec.decode CJ.jobject json parsed <- for array \(Tuple k v) -> do - key <- Either.note (CA.AtKey k (CA.TypeMismatch type_)) (parse k) - val <- lmap (CA.AtKey k) (CA.decode valueCodec v) + key <- except $ lmap + (CJ.DecodeError.error (JSON.Path.AtKey k JSON.Path.Tip) <<< append (typeName <> ": ")) + (parse k) + val <- withExcept + (CJ.DecodeError.withPath (\p -> JSON.Path.extend p (JSON.Path.AtKey k JSON.Path.Tip))) + (Codec.decode valueCodec v) pure $ Tuple key val pure $ Map.fromFoldable parsed diff --git a/lib/src/License.purs b/lib/src/License.purs index 57233728b..fa5ab9723 100644 --- a/lib/src/License.purs +++ b/lib/src/License.purs @@ -16,12 +16,15 @@ module Registry.License import Prelude -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA +import Codec.JSON.DecodeError as CJ.DecodeError +import Control.Monad.Except (Except, except) +import Data.Bifunctor (lmap) +import Data.Codec as Codec +import Data.Codec.JSON as CJ import Data.Either (Either(..)) -import Data.Either as Either import Data.Function.Uncurried (Fn3, runFn3) import Data.String as String +import JSON (JSON) import Safe.Coerce (coerce) -- | An SPDX license identifier such as 'MIT' or 'Apache-2.0'. @@ -30,8 +33,14 @@ newtype License = License String derive newtype instance Eq License -- | A codec for encoding and decoding a `License` as JSON -codec :: JsonCodec License -codec = CA.prismaticCodec "License" (Either.hush <<< parse) print CA.string +codec :: CJ.Codec License +codec = CJ.named "License" $ Codec.codec' decode encode + where + decode :: JSON -> Except CJ.DecodeError License + decode = except <<< lmap CJ.DecodeError.basic <<< parse <=< Codec.decode CJ.string + + encode :: License -> JSON + encode = print >>> CJ.encode CJ.string -- | Print an SPDX license identifier as a string. print :: License -> String diff --git a/lib/src/Location.purs b/lib/src/Location.purs index 7f2c779e4..64685bf33 100644 --- a/lib/src/Location.purs +++ b/lib/src/Location.purs @@ -13,10 +13,9 @@ module Registry.Location import Prelude import Control.Alt ((<|>)) -import Data.Bifunctor (lmap) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Record as CA.Record +import Data.Codec as Codec +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Record as CJ.Record import Data.Maybe (Maybe) import Data.Profunctor as Profunctor import Node.Path (FilePath) @@ -34,17 +33,16 @@ derive instance Eq Location -- | A codec for encoding and decoding a `Location` as JSON. To see how each -- | possible `Location` is represented, please see the relevant codec (for -- | example the `githubCodec` or `gitCodec` implementations). -codec :: JsonCodec Location -codec = CA.codec' decode encode +codec :: CJ.Codec Location +codec = CJ.named "Location" $ Codec.codec' decode encode where - decode json = - lmap (const (CA.TypeMismatch "Location")) do - map Git (CA.decode gitCodec json) - <|> map GitHub (CA.decode githubCodec json) + decode json = do + map Git (Codec.decode gitCodec json) + <|> map GitHub (Codec.decode githubCodec json) encode = case _ of - Git git -> CA.encode gitCodec git - GitHub github -> CA.encode githubCodec github + Git git -> CJ.encode gitCodec git + GitHub github -> CJ.encode githubCodec github -- | The location of a package within a GitHub repository type GitHubData = @@ -56,11 +54,11 @@ type GitHubData = -- | Encode `GitHubData` as a Json object. The JSON representation of the GitHub -- | type uses 'githubOwner' and 'githubRepo', but in PureScript we use 'owner' -- | and 'repo' for convenience. -githubCodec :: JsonCodec GitHubData -githubCodec = Profunctor.dimap toJsonRep fromJsonRep $ CA.Record.object "GitHub" - { githubOwner: CA.string - , githubRepo: CA.string - , subdir: CA.Record.optional CA.string +githubCodec :: CJ.Codec GitHubData +githubCodec = Profunctor.dimap toJsonRep fromJsonRep $ CJ.named "GitHub" $ CJ.Record.object + { githubOwner: CJ.string + , githubRepo: CJ.string + , subdir: CJ.Record.optional CJ.string } where toJsonRep { owner, repo, subdir } = { githubOwner: owner, githubRepo: repo, subdir } @@ -74,10 +72,10 @@ type GitData = -- | Encode `GitData` as a Json object. The JSON representation of the GitHub -- | type uses 'gitUrl' but in PureScript we use 'url' for convenience. -gitCodec :: JsonCodec GitData -gitCodec = Profunctor.dimap toJsonRep fromJsonRep $ CA.Record.object "Git" - { gitUrl: Internal.Codec.parsedString "GitUrl" Internal.Parsing.gitUrl - , subdir: CA.Record.optional CA.string +gitCodec :: CJ.Codec GitData +gitCodec = Profunctor.dimap toJsonRep fromJsonRep $ CJ.named "Git" $ CJ.Record.object + { gitUrl: Internal.Codec.parsedString Internal.Parsing.gitUrl + , subdir: CJ.Record.optional CJ.string } where -- The JSON representation of the GitHub type uses 'gitUrl', but in PureScript diff --git a/lib/src/Manifest.purs b/lib/src/Manifest.purs index c9cbaeb43..0d5504b5b 100644 --- a/lib/src/Manifest.purs +++ b/lib/src/Manifest.purs @@ -20,9 +20,8 @@ import Prelude import Data.Array as Array import Data.Array.NonEmpty (NonEmptyArray) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Common as CA.Common +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Common as CJ.Common import Data.Map (Map) import Data.Maybe (Maybe) import Data.Newtype (class Newtype) @@ -72,15 +71,15 @@ instance Ord Manifest where -- | A codec for encoding and decoding a `Manifest` as JSON. Represented as a -- | JSON object. The implementation uses explicitly ordered keys instead of -- | record sugar. -codec :: JsonCodec Manifest -codec = Profunctor.wrapIso Manifest $ CA.object "Manifest" - $ CA.recordProp (Proxy :: _ "name") PackageName.codec - $ CA.recordProp (Proxy :: _ "version") Version.codec - $ CA.recordProp (Proxy :: _ "license") License.codec - $ CA.recordPropOptional (Proxy :: _ "description") (Internal.Codec.limitedString 300) - $ CA.recordProp (Proxy :: _ "location") Location.codec - $ CA.recordPropOptional (Proxy :: _ "owners") (CA.Common.nonEmptyArray Owner.codec) - $ CA.recordPropOptional (Proxy :: _ "includeFiles") (CA.Common.nonEmptyArray CA.Common.nonEmptyString) - $ CA.recordPropOptional (Proxy :: _ "excludeFiles") (CA.Common.nonEmptyArray CA.Common.nonEmptyString) - $ CA.recordProp (Proxy :: _ "dependencies") (Internal.Codec.packageMap Range.codec) - $ CA.record +codec :: CJ.Codec Manifest +codec = Profunctor.wrapIso Manifest $ CJ.named "Manifest" $ CJ.object + $ CJ.recordProp (Proxy :: _ "name") PackageName.codec + $ CJ.recordProp (Proxy :: _ "version") Version.codec + $ CJ.recordProp (Proxy :: _ "license") License.codec + $ CJ.recordPropOptional (Proxy :: _ "description") (Internal.Codec.limitedString 300) + $ CJ.recordProp (Proxy :: _ "location") Location.codec + $ CJ.recordPropOptional (Proxy :: _ "owners") (CJ.Common.nonEmptyArray Owner.codec) + $ CJ.recordPropOptional (Proxy :: _ "includeFiles") (CJ.Common.nonEmptyArray CJ.Common.nonEmptyString) + $ CJ.recordPropOptional (Proxy :: _ "excludeFiles") (CJ.Common.nonEmptyArray CJ.Common.nonEmptyString) + $ CJ.recordProp (Proxy :: _ "dependencies") (Internal.Codec.packageMap Range.codec) + $ CJ.record diff --git a/lib/src/ManifestIndex.purs b/lib/src/ManifestIndex.purs index 6029b8e34..c867b5d9b 100644 --- a/lib/src/ManifestIndex.purs +++ b/lib/src/ManifestIndex.purs @@ -29,13 +29,12 @@ module Registry.ManifestIndex import Prelude -import Data.Argonaut.Core as Argonaut -import Data.Argonaut.Parser as Argonaut.Parser +import Codec.JSON.DecodeError as CJ.DecodeError import Data.Array as Array import Data.Array.NonEmpty (NonEmptyArray) import Data.Array.NonEmpty as NonEmptyArray import Data.Bifunctor (lmap) -import Data.Codec.Argonaut as CA +import Data.Codec.JSON as CJ import Data.Either (Either(..)) import Data.Graph (Graph) import Data.Graph as Graph @@ -57,6 +56,7 @@ import Data.Tuple (Tuple(..)) import Effect.Aff as Aff import Effect.Aff.Class (class MonadAff, liftAff) import Effect.Class (liftEffect) +import JSON as JSON import Node.Encoding (Encoding(..)) import Node.FS.Aff as FS.Aff import Node.FS.Perms as FS.Perms @@ -244,8 +244,8 @@ packageEntryFilePath name = Path.concat [ packageEntryDirectory name, PackageNam parseEntry :: String -> Either String (NonEmptyArray Manifest) parseEntry entry = do let split = String.split (String.Pattern "\n") <<< String.trim - jsonArray <- traverse Argonaut.Parser.jsonParser (split entry) - entries <- traverse (lmap CA.printJsonDecodeError <<< CA.decode Manifest.codec) jsonArray + jsonArray <- traverse JSON.parse (split entry) + entries <- traverse (lmap CJ.DecodeError.print <<< CJ.decode Manifest.codec) jsonArray case NonEmptyArray.fromArray entries of Nothing -> Left "No entries exist." Just entries' -> pure entries' @@ -254,7 +254,7 @@ parseEntry entry = do -- | lowest version to highest version. printEntry :: NonEmptySet Manifest -> String printEntry = - Array.foldMap ((_ <> "\n") <<< Argonaut.stringify <<< CA.encode Manifest.codec) + Array.foldMap ((_ <> "\n") <<< JSON.print <<< CJ.encode Manifest.codec) <<< Array.sortBy (comparing (_.version <<< un Manifest)) <<< Array.fromFoldable diff --git a/lib/src/Metadata.purs b/lib/src/Metadata.purs index f8e774176..3724f6708 100644 --- a/lib/src/Metadata.purs +++ b/lib/src/Metadata.purs @@ -21,10 +21,9 @@ module Registry.Metadata import Prelude import Data.Array.NonEmpty (NonEmptyArray) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Common as CA.Common -import Data.Codec.Argonaut.Record as CA.Record +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Common as CJ.Common +import Data.Codec.JSON.Record as CJ.Record import Data.DateTime (DateTime) import Data.Map (Map) import Data.Maybe (Maybe) @@ -55,13 +54,13 @@ derive instance Eq Metadata -- | A codec for encoding and decoding a `Metadata` value as JSON. Represented -- | as a JSON object. Keys are explicitly ordered. -codec :: JsonCodec Metadata -codec = Profunctor.wrapIso Metadata $ CA.object "Metadata" - $ CA.recordProp (Proxy :: _ "location") Location.codec - $ CA.recordPropOptional (Proxy :: _ "owners") (CA.Common.nonEmptyArray Owner.codec) - $ CA.recordProp (Proxy :: _ "published") (Internal.Codec.versionMap publishedMetadataCodec) - $ CA.recordProp (Proxy :: _ "unpublished") (Internal.Codec.versionMap unpublishedMetadataCodec) - $ CA.record +codec :: CJ.Codec Metadata +codec = Profunctor.wrapIso Metadata $ CJ.named "Metadata" $ CJ.object + $ CJ.recordProp (Proxy :: _ "location") Location.codec + $ CJ.recordPropOptional (Proxy :: _ "owners") (CJ.Common.nonEmptyArray Owner.codec) + $ CJ.recordProp (Proxy :: _ "published") (Internal.Codec.versionMap publishedMetadataCodec) + $ CJ.recordProp (Proxy :: _ "unpublished") (Internal.Codec.versionMap unpublishedMetadataCodec) + $ CJ.record -- | Metadata about a published package version. -- | @@ -74,12 +73,12 @@ type PublishedMetadata = , ref :: String } -publishedMetadataCodec :: JsonCodec PublishedMetadata -publishedMetadataCodec = CA.Record.object "PublishedMetadata" - { bytes: CA.number +publishedMetadataCodec :: CJ.Codec PublishedMetadata +publishedMetadataCodec = CJ.named "PublishedMetadata" $ CJ.Record.object + { bytes: CJ.number , hash: Sha256.codec , publishedTime: Internal.Codec.iso8601DateTime - , ref: CA.string + , ref: CJ.string } -- | Metadata about an unpublished package version. @@ -89,8 +88,8 @@ type UnpublishedMetadata = , unpublishedTime :: DateTime } -unpublishedMetadataCodec :: JsonCodec UnpublishedMetadata -unpublishedMetadataCodec = CA.Record.object "UnpublishedMetadata" +unpublishedMetadataCodec :: CJ.Codec UnpublishedMetadata +unpublishedMetadataCodec = CJ.named "UnpublishedMetadata" $ CJ.Record.object { publishedTime: Internal.Codec.iso8601DateTime , reason: Internal.Codec.limitedString 300 , unpublishedTime: Internal.Codec.iso8601DateTime diff --git a/lib/src/Operation.purs b/lib/src/Operation.purs index 2015c8202..98c35f092 100644 --- a/lib/src/Operation.purs +++ b/lib/src/Operation.purs @@ -31,15 +31,17 @@ module Registry.Operation import Prelude +import Codec.JSON.DecodeError as JSON.DecodeError import Control.Alt ((<|>)) -import Data.Argonaut.Parser as Argonaut.Parser +import Control.Monad.Except (except) import Data.Bifunctor (lmap) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Compat as CA.Compat -import Data.Codec.Argonaut.Record as CA.Record +import Data.Codec as Codec +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Common as CJ.Common +import Data.Codec.JSON.Record as CJ.Record import Data.Map (Map) import Data.Maybe (Maybe) +import JSON as JSON import Registry.Internal.Codec as Internal.Codec import Registry.Location (Location) import Registry.Location as Location @@ -77,13 +79,13 @@ type PublishData = } -- | A codec for encoding and decoding a `Publish` operation as JSON. -publishCodec :: JsonCodec PublishData -publishCodec = CA.Record.object "Publish" +publishCodec :: CJ.Codec PublishData +publishCodec = CJ.named "Publish" $ CJ.Record.object { name: PackageName.codec - , location: CA.Record.optional Location.codec - , ref: CA.string + , location: CJ.Record.optional Location.codec + , ref: CJ.string , compiler: Version.codec - , resolutions: CA.Record.optional (Internal.Codec.packageMap Version.codec) + , resolutions: CJ.Record.optional (Internal.Codec.packageMap Version.codec) } -- | Authenticate a package operation to send to the registry. @@ -97,39 +99,43 @@ type AuthenticatedData = } -- | A codec for encoding and decoding authenticated operations as JSON. -authenticatedCodec :: JsonCodec AuthenticatedData -authenticatedCodec = toPureScriptRep $ CA.Record.object "Authenticated" - { payload: CA.string - , signature: CA.string - } +authenticatedCodec :: CJ.Codec AuthenticatedData +authenticatedCodec = topLevelCodec where -- We first parse the payload as a simple string to use in verification so as -- to preserve any quirks of formatting that could change the hash of its -- contents. However, we also need to decode the operation itself, and so we -- parse that in a second pass over the input. - toPureScriptRep codec = CA.codec' decode encode + topLevelCodec :: CJ.Codec AuthenticatedData + topLevelCodec = CJ.named "Authenticated" $ Codec.codec' decode encode where decode json = do - rep <- CA.decode codec json - payloadJson <- lmap (CA.TypeMismatch <<< append "Json: ") (Argonaut.Parser.jsonParser rep.payload) - operation <- CA.decode payloadCodec payloadJson + rep <- Codec.decode repCodec json + payloadJson <- except $ lmap JSON.DecodeError.basic $ JSON.parse rep.payload + operation <- Codec.decode payloadCodec payloadJson pure { payload: operation, rawPayload: rep.payload, signature: Signature rep.signature } encode { rawPayload, signature: Signature signature } = - CA.encode codec { payload: rawPayload, signature } + CJ.encode repCodec { payload: rawPayload, signature } + + repCodec :: CJ.Codec { payload :: String, signature :: String } + repCodec = CJ.named "AuthenticatedData" $ CJ.Record.object + { payload: CJ.string + , signature: CJ.string + } -- The only acceptable payloads for an authenticated operation are the -- `AuthenticatedPackageOperation`s. - payloadCodec = CA.codec' decode encode + payloadCodec :: CJ.Codec AuthenticatedPackageOperation + payloadCodec = CJ.named "AuthenticatedPackageOperation" $ Codec.codec' decode encode where decode json = - lmap (const (CA.TypeMismatch "AuthenticatedPackageOperation")) do - map Unpublish (CA.decode unpublishCodec json) - <|> map Transfer (CA.decode transferCodec json) + map Unpublish (Codec.decode unpublishCodec json) + <|> map Transfer (Codec.decode transferCodec json) encode = case _ of - Unpublish unpublish -> CA.encode unpublishCodec unpublish - Transfer transfer -> CA.encode transferCodec transfer + Unpublish unpublish -> CJ.encode unpublishCodec unpublish + Transfer transfer -> CJ.encode transferCodec transfer -- | Unpublish a package version from the registry. This operation must be -- | authenticated and not all package versions can be unpublished. @@ -143,8 +149,8 @@ type UnpublishData = } -- | A codec for encoding and decoding an `Unpublish` operation as JSON. -unpublishCodec :: JsonCodec UnpublishData -unpublishCodec = CA.Record.object "Unpublish" +unpublishCodec :: CJ.Codec UnpublishData +unpublishCodec = CJ.named "Unpublish" $ CJ.Record.object { name: PackageName.codec , version: Version.codec , reason: Internal.Codec.limitedString 300 @@ -161,8 +167,8 @@ type TransferData = } -- | A codec for encoding and decoding a `Transfer` operation as JSON. -transferCodec :: JsonCodec TransferData -transferCodec = CA.Record.object "Transfer" +transferCodec :: CJ.Codec TransferData +transferCodec = CJ.named "Transfer" $ CJ.Record.object { name: PackageName.codec , newLocation: Location.codec } @@ -182,12 +188,12 @@ type PackageSetUpdateData = } -- | A codec for encoding and decoding a `PackageSetUpdate` operation as JSON. -packageSetUpdateCodec :: JsonCodec PackageSetUpdateData -packageSetUpdateCodec = CA.Record.object "PackageSetUpdate" - { compiler: CA.Record.optional Version.codec +packageSetUpdateCodec :: CJ.Codec PackageSetUpdateData +packageSetUpdateCodec = CJ.named "PackageSetUpdate" $ CJ.Record.object + { compiler: CJ.Record.optional Version.codec -- We encode and decode `Nothing` values as `null` when working with versions, -- as the absence of the key altogether means not to update it, while the -- presence of `null` means to remove the package. For that reason we use the -- `Compat` version of the `maybe` codec. - , packages: Internal.Codec.packageMap (CA.Compat.maybe Version.codec) + , packages: Internal.Codec.packageMap (CJ.Common.nullable Version.codec) } diff --git a/lib/src/Owner.purs b/lib/src/Owner.purs index 76ac02b31..e5fff9cce 100644 --- a/lib/src/Owner.purs +++ b/lib/src/Owner.purs @@ -11,9 +11,8 @@ module Registry.Owner import Prelude -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Record as CA.Record +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Record as CJ.Record import Data.Maybe (Maybe) import Data.Newtype (class Newtype) import Data.Profunctor as Profunctor @@ -30,9 +29,9 @@ derive newtype instance Eq Owner -- | A codec for encoding and decoding an `Owner` as JSON. Represented as a JSON -- | object. -codec :: JsonCodec Owner -codec = Profunctor.wrapIso Owner $ CA.Record.object "Owner" - { id: CA.Record.optional CA.string - , keytype: CA.string - , public: CA.string +codec :: CJ.Codec Owner +codec = Profunctor.wrapIso Owner $ CJ.named "Owner" $ CJ.Record.object + { id: CJ.Record.optional CJ.string + , keytype: CJ.string + , public: CJ.string } diff --git a/lib/src/PackageName.purs b/lib/src/PackageName.purs index 2da89792f..ccedf9f37 100644 --- a/lib/src/PackageName.purs +++ b/lib/src/PackageName.purs @@ -12,18 +12,21 @@ module Registry.PackageName import Prelude +import Codec.JSON.DecodeError as CJ.DecodeError import Control.Alt ((<|>)) +import Control.Monad.Except (Except, except) import Data.Array as Array import Data.Array.NonEmpty as NonEmptyArray import Data.Bifunctor (lmap) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Either (Either, hush) +import Data.Codec as Codec +import Data.Codec.JSON as CJ +import Data.Either (Either) import Data.Maybe (Maybe(..), isJust) import Data.Maybe as Maybe import Data.String as String import Data.String.CodeUnits as String.CodeUnits import Data.Tuple (fst) +import JSON (JSON) import Parsing (Parser) import Parsing as Parsing import Parsing.Combinators as Parsing.Combinators @@ -51,8 +54,14 @@ derive newtype instance Eq PackageName derive newtype instance Ord PackageName -- | A codec for encoding and decoding a `PackageName` as a JSON string -codec :: JsonCodec PackageName -codec = CA.prismaticCodec "PackageName" (hush <<< parse) print CA.string +codec :: CJ.Codec PackageName +codec = CJ.named "PackageName" $ Codec.codec' decode encode + where + decode :: JSON -> Except CJ.DecodeError PackageName + decode = except <<< lmap CJ.DecodeError.basic <<< parse <=< Codec.decode CJ.string + + encode :: PackageName -> JSON + encode = print >>> CJ.encode CJ.string -- | Print a package name as a string print :: PackageName -> String diff --git a/lib/src/PackageSet.purs b/lib/src/PackageSet.purs index 2f6ec0181..6e6d8b005 100644 --- a/lib/src/PackageSet.purs +++ b/lib/src/PackageSet.purs @@ -14,8 +14,7 @@ module Registry.PackageSet import Prelude -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA +import Data.Codec.JSON as CJ import Data.DateTime (Date) import Data.Map (Map) import Data.Newtype (class Newtype) @@ -41,10 +40,10 @@ derive newtype instance Eq PackageSet -- | A codec for encoding and decoding a `PackageSet` as JSON. Represented as a -- | JSON object. We use an explicit ordering instead of record sugar in the -- | implementation. -codec :: JsonCodec PackageSet -codec = Profunctor.wrapIso PackageSet $ CA.object "PackageSet" - $ CA.recordProp (Proxy :: _ "version") Version.codec - $ CA.recordProp (Proxy :: _ "compiler") Version.codec - $ CA.recordProp (Proxy :: _ "published") Internal.Codec.iso8601Date - $ CA.recordProp (Proxy :: _ "packages") (Internal.Codec.packageMap Version.codec) - $ CA.record +codec :: CJ.Codec PackageSet +codec = Profunctor.wrapIso PackageSet $ CJ.named "PackageSet" $ CJ.object + $ CJ.recordProp (Proxy :: _ "version") Version.codec + $ CJ.recordProp (Proxy :: _ "compiler") Version.codec + $ CJ.recordProp (Proxy :: _ "published") Internal.Codec.iso8601Date + $ CJ.recordProp (Proxy :: _ "packages") (Internal.Codec.packageMap Version.codec) + $ CJ.record diff --git a/lib/src/PursGraph.purs b/lib/src/PursGraph.purs index fdcef5268..5ed1e512b 100644 --- a/lib/src/PursGraph.purs +++ b/lib/src/PursGraph.purs @@ -10,9 +10,8 @@ import Data.Array.NonEmpty (NonEmptyArray) import Data.Array.NonEmpty as NonEmptyArray import Data.Array.ST as Array.ST import Data.Bifunctor (bimap) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Record as CA.Record +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Record as CJ.Record import Data.Either (Either(..)) import Data.Map (Map) import Data.Map as Map @@ -33,18 +32,18 @@ import Safe.Coerce (coerce) -- | compiler from a set of source files. type PursGraph = Map ModuleName PursGraphNode -pursGraphCodec :: JsonCodec PursGraph -pursGraphCodec = Internal.Codec.strMap "PursGraph" (Just <<< ModuleName) (un ModuleName) pursGraphNodeCodec +pursGraphCodec :: CJ.Codec PursGraph +pursGraphCodec = Internal.Codec.strMap "PursGraph" (Right <<< ModuleName) (un ModuleName) pursGraphNodeCodec type PursGraphNode = { depends :: Array ModuleName , path :: FilePath } -pursGraphNodeCodec :: JsonCodec PursGraphNode -pursGraphNodeCodec = CA.Record.object "PursGraphNode" - { depends: CA.array moduleNameCodec - , path: CA.string +pursGraphNodeCodec :: CJ.Codec PursGraphNode +pursGraphNodeCodec = CJ.named "PursGraphNode" $ CJ.Record.object + { depends: CJ.array moduleNameCodec + , path: CJ.string } -- | A module name string from a 'purs graph' invocation. @@ -54,8 +53,8 @@ derive instance Newtype ModuleName _ derive instance Eq ModuleName derive instance Ord ModuleName -moduleNameCodec :: JsonCodec ModuleName -moduleNameCodec = Profunctor.wrapIso ModuleName CA.string +moduleNameCodec :: CJ.Codec ModuleName +moduleNameCodec = Profunctor.wrapIso ModuleName CJ.string type AssociatedError = { module :: ModuleName, path :: FilePath, error :: String } diff --git a/lib/src/Range.purs b/lib/src/Range.purs index 11e50b74a..4438d2383 100644 --- a/lib/src/Range.purs +++ b/lib/src/Range.purs @@ -18,16 +18,19 @@ module Registry.Range import Prelude +import Codec.JSON.DecodeError as CJ.DecodeError import Control.Alt ((<|>)) import Control.Monad.Error.Class as Error +import Control.Monad.Except (Except, except) import Data.Array as Array import Data.Bifunctor (lmap) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Either (Either, hush) +import Data.Codec as Codec +import Data.Codec.JSON as CJ +import Data.Either (Either) import Data.Function (on) import Data.Maybe (Maybe(..)) import Data.String.CodeUnits as String.CodeUnits +import JSON (JSON) import Parsing (Parser) import Parsing as Parsing import Parsing.String as Parsing.String @@ -47,8 +50,14 @@ instance Eq Range where -- | A codec for encoding and decoding a `Range` as JSON. Ranges are encoded as -- | strings of the form ">=X.Y.Z Except CJ.DecodeError Range + decode = except <<< lmap CJ.DecodeError.basic <<< parse <=< Codec.decode CJ.string + + encode :: Range -> JSON + encode = print >>> CJ.encode CJ.string -- | Print a range in the form ">=X.Y.Z String diff --git a/lib/src/Sha256.purs b/lib/src/Sha256.purs index 3b57c0f38..4c07eddae 100644 --- a/lib/src/Sha256.purs +++ b/lib/src/Sha256.purs @@ -15,16 +15,19 @@ module Registry.Sha256 import Prelude +import Codec.JSON.DecodeError as CJ.DecodeError +import Control.Monad.Except (Except, except) import Data.Array as Array import Data.Bifunctor (lmap) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Either (Either, hush) +import Data.Codec as Codec +import Data.Codec.JSON as CJ +import Data.Either (Either) import Data.List.Lazy as List.Lazy import Data.String.CodeUnits as String.CodeUnits import Effect (Effect) import Effect.Aff.Class (class MonadAff, liftAff) import Effect.Class (class MonadEffect, liftEffect) +import JSON (JSON) import Node.Buffer (Buffer) import Node.Buffer as Buffer import Node.Encoding (Encoding(..)) @@ -41,8 +44,14 @@ newtype Sha256 = Sha256 { sri :: String, hash :: String } derive instance Eq Sha256 -- | A codec for encoding and decoding a `Sha256` as a JSON string -codec :: JsonCodec Sha256 -codec = CA.prismaticCodec "Sha256" (hush <<< parse) print CA.string +codec :: CJ.Codec Sha256 +codec = CJ.named "Sha256" $ Codec.codec' decode encode + where + decode :: JSON -> Except CJ.DecodeError Sha256 + decode = except <<< lmap CJ.DecodeError.basic <<< parse <=< Codec.decode CJ.string + + encode :: Sha256 -> JSON + encode = print >>> CJ.encode CJ.string -- | Print a Sha256 as a subresource integrity hash using sha256 print :: Sha256 -> String diff --git a/lib/src/Version.purs b/lib/src/Version.purs index 27127e419..9e9e4df3c 100644 --- a/lib/src/Version.purs +++ b/lib/src/Version.purs @@ -18,16 +18,19 @@ module Registry.Version import Prelude +import Codec.JSON.DecodeError as CJ.DecodeError +import Control.Monad.Except (Except, except) import Data.Array as Array import Data.Array.NonEmpty as NonEmptyArray import Data.Bifunctor (lmap) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Either (Either, hush) +import Data.Codec as Codec +import Data.Codec.JSON as CJ +import Data.Either (Either) import Data.Int as Int import Data.Maybe (maybe) import Data.String as String import Data.String.CodeUnits as CodeUnits +import JSON (JSON) import Parsing (Parser) import Parsing as Parsing import Parsing.Combinators.Array as Parsing.Combinators.Array @@ -61,8 +64,14 @@ instance Ord Version where x -> x -- | A codec for encoding and decoding a `Version` as a JSON string. -codec :: JsonCodec Version -codec = CA.prismaticCodec "Version" (hush <<< parse) print CA.string +codec :: CJ.Codec Version +codec = CJ.named "Version" $ Codec.codec' decode encode + where + decode :: JSON -> Except CJ.DecodeError Version + decode = except <<< lmap CJ.DecodeError.basic <<< parse <=< Codec.decode CJ.string + + encode :: Version -> JSON + encode = print >>> CJ.encode CJ.string -- | Print a `Version` as a string of the form "X.Y.Z" print :: Version -> String diff --git a/lib/test/Registry/ManifestIndex.purs b/lib/test/Registry/ManifestIndex.purs index b66395289..c37d6875a 100644 --- a/lib/test/Registry/ManifestIndex.purs +++ b/lib/test/Registry/ManifestIndex.purs @@ -3,11 +3,9 @@ module Test.Registry.ManifestIndex (spec) where import Prelude import Control.Monad.Error.Class (class MonadThrow) -import Data.Argonaut.Core as Argonaut import Data.Array as Array -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Record as CA.Record +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Record as CJ.Record import Data.Either (Either(..)) import Data.Int as Int import Data.List as List @@ -23,6 +21,7 @@ import Data.String as String import Data.Tuple (Tuple(..)) import Data.Tuple.Nested ((/\)) import Effect.Exception (Error) +import JSON as JSON import Node.Path as Path import Registry.Internal.Codec as Internal.Codec import Registry.Location (Location(..)) @@ -204,25 +203,25 @@ testSorted input = do let sorted = ManifestIndex.topologicalSort ManifestIndex.IgnoreRanges (Set.fromFoldable input) unless (input == sorted) do Assert.fail $ String.joinWith "\n" - [ Argonaut.stringifyWithIndent 2 $ CA.encode (CA.array manifestCodec') input + [ JSON.printIndented $ CJ.encode (CJ.array manifestCodec') input , " is not equal to " - , Argonaut.stringifyWithIndent 2 $ CA.encode (CA.array manifestCodec') sorted + , JSON.printIndented $ CJ.encode (CJ.array manifestCodec') sorted ] formatInsertErrors :: Map PackageName Range -> String formatInsertErrors errors = String.joinWith "\n" [ "Failed to insert. Failed to satisfy:" - , Argonaut.stringifyWithIndent 2 $ CA.encode (Internal.Codec.packageMap Range.codec) errors + , JSON.printIndented $ CJ.encode (Internal.Codec.packageMap Range.codec) errors ] formatIndex :: ManifestIndex -> String formatIndex = - Argonaut.stringifyWithIndent 2 - <<< CA.encode (Internal.Codec.packageMap (Internal.Codec.versionMap manifestCodec')) + JSON.printIndented + <<< CJ.encode (Internal.Codec.packageMap (Internal.Codec.versionMap manifestCodec')) <<< ManifestIndex.toMap -manifestCodec' :: JsonCodec Manifest -manifestCodec' = Profunctor.dimap to from $ CA.Record.object "ManifestRep" +manifestCodec' :: CJ.Codec Manifest +manifestCodec' = Profunctor.dimap to from $ CJ.named "ManifestRep" $ CJ.Record.object { name: PackageName.codec , version: Version.codec , dependencies: Internal.Codec.packageMap Range.codec diff --git a/lib/test/Registry/PursGraph.purs b/lib/test/Registry/PursGraph.purs index 970f14ff3..e39f18718 100644 --- a/lib/test/Registry/PursGraph.purs +++ b/lib/test/Registry/PursGraph.purs @@ -2,10 +2,10 @@ module Test.Registry.PursGraph (spec) where import Prelude -import Data.Argonaut.Parser as Argonaut.Parser +import Codec.JSON.DecodeError as CJ.DecodeError import Data.Array as Array import Data.Array.NonEmpty as NonEmptyArray -import Data.Codec.Argonaut as CA +import Data.Codec.JSON as CJ import Data.Either (Either(..)) import Data.Foldable (for_) import Data.Foldable as Foldable @@ -15,6 +15,7 @@ import Data.Maybe as Maybe import Data.Set (Set) import Data.Set as Set import Data.String as String +import JSON as JSON import Node.Encoding (Encoding(..)) import Node.FS.Aff as FS.Aff import Node.Path as Path @@ -29,10 +30,10 @@ import Test.Spec as Spec spec :: Spec.Spec Unit spec = do let - parse raw = case Argonaut.Parser.jsonParser raw of + parse raw = case JSON.parse raw of Left err -> Left $ "Failed to parse graph as JSON:\n\n" <> raw <> "\n\n due to an error:\n\n" <> err - Right json -> case CA.decode PursGraph.pursGraphCodec json of - Left err -> Left $ "Failed to decode graph JSON:\n\n" <> CA.printJsonDecodeError err + Right json -> case CJ.decode PursGraph.pursGraphCodec json of + Left err -> Left $ "Failed to decode graph JSON:\n\n" <> CJ.DecodeError.print err Right result -> pure result Spec.it "type-equality (no deps)" do diff --git a/lib/test/Registry/Test/Assert.purs b/lib/test/Registry/Test/Assert.purs index 6a5a4594a..55c0f2277 100644 --- a/lib/test/Registry/Test/Assert.purs +++ b/lib/test/Registry/Test/Assert.purs @@ -2,18 +2,17 @@ module Registry.Test.Assert where import Prelude +import Codec.JSON.DecodeError as CJ.DecodeError import Control.Monad.Error.Class (class MonadThrow) -import Data.Argonaut.Core as Argonaut -import Data.Argonaut.Parser as Argonaut.Parser import Data.Array as Array import Data.Bifunctor (lmap) -import Data.Codec.Argonaut (JsonCodec) -import Data.Codec.Argonaut as CA +import Data.Codec.JSON as CJ import Data.Either (Either(..)) import Data.Foldable (class Foldable) import Data.Foldable as Foldable import Data.String as String import Effect.Exception (Error) +import JSON as JSON import Registry.Test.Utils as Utils import Test.Spec.Assertions (AnyShow(..)) import Test.Spec.Assertions as Assertions @@ -51,11 +50,11 @@ shouldNotSatisfy a predicate = type Fixture = { label :: String, value :: String } -shouldRoundTrip :: forall m a. MonadThrow Error m => String -> JsonCodec a -> Array Fixture -> m Unit +shouldRoundTrip :: forall m a. MonadThrow Error m => String -> CJ.Codec a -> Array Fixture -> m Unit shouldRoundTrip type_ codec fixtures = do let parseFixture { label, value } = - case lmap CA.printJsonDecodeError <<< CA.decode codec =<< Argonaut.Parser.jsonParser value of + case lmap CJ.DecodeError.print <<< CJ.decode codec =<< JSON.parse value of Left error -> Left { label, input: value, error } Right result -> Right { label, input: value, result } @@ -71,7 +70,7 @@ shouldRoundTrip type_ codec fixtures = do let roundtrip = fixtureParseResult.success <#> \fields -> do - let printed = Argonaut.stringifyWithIndent 2 $ CA.encode codec fields.result + let printed = JSON.printIndented $ CJ.encode codec fields.result let input = String.trim fields.input if input == printed then Right unit else Left { label: fields.label, input, printed } diff --git a/lib/test/Registry/Test/Utils.purs b/lib/test/Registry/Test/Utils.purs index 23ad710ba..58d9f8128 100644 --- a/lib/test/Registry/Test/Utils.purs +++ b/lib/test/Registry/Test/Utils.purs @@ -2,7 +2,6 @@ module Registry.Test.Utils where import Prelude -import Data.Argonaut.Core as Argonaut import Data.Array as Array import Data.Array.NonEmpty as NonEmptyArray import Data.Bifunctor (bimap) @@ -14,6 +13,8 @@ import Data.Formatter.DateTime as DateTime.Formatters import Data.Map as Map import Data.Maybe (Maybe(..)) import Data.Tuple (Tuple) +import JSON (JSON) +import JSON as JSON import Partial.Unsafe (unsafeCrashWith) import Partial.Unsafe as Partial import Registry.Internal.Format as Internal.Format @@ -44,7 +45,7 @@ fromRight msg = Either.fromRight' (\_ -> Partial.unsafeCrashWith msg) -- | Unsafely stringify a value by coercing it to `Json` and stringifying it. unsafeStringify :: forall a. a -> String -unsafeStringify a = Argonaut.stringify (unsafeCoerce a :: Argonaut.Json) +unsafeStringify a = JSON.print (unsafeCoerce a :: JSON) -- | Partition an array of `Either` values into failure and success values partitionEithers :: forall e a. Array (Either e a) -> { fail :: Array e, success :: Array a } diff --git a/scripts/spago.yaml b/scripts/spago.yaml index d3c989df5..4d9a26b0e 100644 --- a/scripts/spago.yaml +++ b/scripts/spago.yaml @@ -5,12 +5,10 @@ package: version: 0.0.1 dependencies: - aff - - argonaut-core - argparse-basic - arrays - - codec-argonaut + - codec-json - console - - control - datetime - either - exceptions @@ -18,8 +16,10 @@ package: - filterable - foldable-traversable - formatters + - json - lists - newtype + - node-fs - node-path - node-process - now diff --git a/scripts/src/CompilerVersions.purs b/scripts/src/CompilerVersions.purs index 42dd5d850..127d0b971 100644 --- a/scripts/src/CompilerVersions.purs +++ b/scripts/src/CompilerVersions.purs @@ -6,10 +6,10 @@ import ArgParse.Basic (ArgParser) import ArgParse.Basic as Arg import Data.Array as Array import Data.Array.NonEmpty as NEA -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Common as Codec.Common -import Data.Codec.Argonaut.Record as CA.Record -import Data.Codec.Argonaut.Variant as CA.Variant +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Common as CJ.Common +import Data.Codec.JSON.Record as CJ.Record +import Data.Codec.JSON.Variant as CJ.Variant import Data.Exists as Exists import Data.Formatter.DateTime as Formatter.DateTime import Data.Map as Map @@ -160,8 +160,8 @@ main = launchAff_ do let resultsFile = "compiler-versions-results-" <> String.take 19 (Formatter.DateTime.format Internal.Format.iso8601DateTime now) <> ".json" failuresFile = "compiler-versions-failures-" <> String.take 19 (Formatter.DateTime.format Internal.Format.iso8601DateTime now) <> ".json" - writeJsonFile (Internal.Codec.packageMap (Internal.Codec.versionMap (CA.array Version.codec))) (Path.concat [ resultsDir, resultsFile ]) results - writeJsonFile (Internal.Codec.versionMap (CA.array failureCodec)) (Path.concat [ resultsDir, failuresFile ]) failures + writeJsonFile (Internal.Codec.packageMap (Internal.Codec.versionMap (CJ.array Version.codec))) (Path.concat [ resultsDir, resultsFile ]) results + writeJsonFile (Internal.Codec.versionMap (CJ.array failureCodec)) (Path.concat [ resultsDir, failuresFile ]) failures compilersForPackageVersion :: forall r @@ -345,8 +345,8 @@ type Failure = , reason :: FailureReason } -failureCodec :: JsonCodec Failure -failureCodec = CA.Record.object "Failure" +failureCodec :: CJ.Codec Failure +failureCodec = CJ.named "Failure" $ CJ.Record.object { name: PackageName.codec , version: Version.codec , reason: failureReasonCodec @@ -364,8 +364,8 @@ data FailureReason derive instance Eq FailureReason -failureReasonCodec :: JsonCodec FailureReason -failureReasonCodec = Profunctor.dimap toVariant fromVariant $ CA.Variant.variantMatch +failureReasonCodec :: CJ.Codec FailureReason +failureReasonCodec = Profunctor.dimap toVariant fromVariant $ CJ.Variant.variantMatch { cannotSolve: Left unit , cannotCompile: Left unit , unknownReason: Left unit @@ -387,10 +387,10 @@ type CompilationResults = , succeeded :: Set Version } -compilationResultsCodec :: JsonCodec CompilationResults -compilationResultsCodec = CA.Record.object "CompilationResults" +compilationResultsCodec :: CJ.Codec CompilationResults +compilationResultsCodec = CJ.named "CompilationResults" $ CJ.Record.object { failed: Internal.Codec.versionMap failureReasonCodec - , succeeded: Codec.Common.set Version.codec + , succeeded: CJ.Common.set Version.codec } -- | A key type for caching compilation results diff --git a/scripts/src/LegacyImporter.purs b/scripts/src/LegacyImporter.purs index c41bd03d8..a9f0079b5 100644 --- a/scripts/src/LegacyImporter.purs +++ b/scripts/src/LegacyImporter.purs @@ -12,10 +12,10 @@ import ArgParse.Basic (ArgParser) import ArgParse.Basic as Arg import Control.Apply (lift2) import Data.Array as Array -import Data.Codec.Argonaut as CA -import Data.Codec.Argonaut.Common as CA.Common -import Data.Codec.Argonaut.Record as CA.Record -import Data.Codec.Argonaut.Variant as CA.Variant +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Common as CJ.Common +import Data.Codec.JSON.Record as CJ.Record +import Data.Codec.JSON.Variant as CJ.Variant import Data.Compactable (separate) import Data.Exists as Exists import Data.Filterable (partition) @@ -70,8 +70,7 @@ import Registry.PackageName as PackageName import Registry.Version as Version import Run (Run) import Run as Run -import Run.Except (EXCEPT, Except) -import Run.Except as Except +import Run.Except (EXCEPT) import Run.Except as Run.Except import Spago.Generated.BuildInfo as BuildInfo import Type.Proxy (Proxy(..)) @@ -166,7 +165,7 @@ main = launchAff_ do # runAppEffects # Cache.interpret Legacy.Manifest._legacyCache (Cache.handleMemoryFs { cache, ref: legacyCacheRef }) # Cache.interpret _importCache (Cache.handleMemoryFs { cache, ref: importCacheRef }) - # Except.catch (\msg -> Log.error msg *> Run.liftEffect (Process.exit' 1)) + # Run.Except.catch (\msg -> Log.error msg *> Run.liftEffect (Process.exit' 1)) # Comment.interpret Comment.handleLog # Log.interpret (\log -> Log.handleTerminal Normal log *> Log.handleFs Verbose logPath log) # Env.runResourceEnv resourceEnv @@ -240,7 +239,7 @@ runLegacyImport mode logs = do -- low. Should be bumped from time to time to the latest compiler. let minCompiler = unsafeFromRight (Version.parse "0.15.7") when (compiler < minCompiler) do - Except.throw $ "Local compiler " <> Version.print compiler <> " is too low (min: " <> Version.print minCompiler <> ")." + Run.Except.throw $ "Local compiler " <> Version.print compiler <> " is too low (min: " <> Version.print minCompiler <> ")." Log.info $ "Using compiler " <> Version.print compiler @@ -254,7 +253,7 @@ runLegacyImport mode logs = do Nothing -> do let formatted = formatPackageVersion manifest.name manifest.version Log.error $ "Unable to recover package ref for " <> formatted - Except.throw $ "Failed to create publish operation for " <> formatted + Run.Except.throw $ "Failed to create publish operation for " <> formatted Just ref -> pure { location: Just manifest.location @@ -294,7 +293,7 @@ runLegacyImport mode logs = do ] operation <- mkOperation (Manifest manifest) - result <- Except.runExcept $ API.publish source operation + result <- Run.Except.runExcept $ API.publish source operation -- TODO: Some packages will fail because the legacy importer does not -- perform all the same validation checks that the publishing flow does. -- What should we do when a package has a valid manifest but fails for @@ -462,7 +461,7 @@ buildLegacyPackageManifests rawPackage rawUrl = Run.Except.runExceptAt _exceptPa pure $ Map.fromFoldable manifests type EXCEPT_VERSION :: Row (Type -> Type) -> Row (Type -> Type) -type EXCEPT_VERSION r = (exceptVersion :: Except VersionValidationError | r) +type EXCEPT_VERSION r = (exceptVersion :: Run.Except.Except VersionValidationError | r) _exceptVersion = Proxy :: Proxy "exceptVersion" @@ -474,10 +473,10 @@ exceptVersion = Run.Except.rethrowAt _exceptVersion type VersionValidationError = { error :: VersionError, reason :: String } -versionValidationErrorCodec :: JsonCodec VersionValidationError -versionValidationErrorCodec = CA.Record.object "VersionValidationError" +versionValidationErrorCodec :: CJ.Codec VersionValidationError +versionValidationErrorCodec = CJ.named "VersionValidationError" $ CJ.Record.object { error: versionErrorCodec - , reason: CA.string + , reason: CJ.string } -- | An error that affects a specific package version @@ -487,19 +486,19 @@ data VersionError | InvalidManifest LegacyManifestValidationError | UnregisteredDependencies (Array PackageName) -versionErrorCodec :: JsonCodec VersionError -versionErrorCodec = Profunctor.dimap toVariant fromVariant $ CA.Variant.variantMatch - { invalidTag: Right $ CA.Record.object "Tag" - { name: CA.string - , sha: CA.string - , url: CA.string +versionErrorCodec :: CJ.Codec VersionError +versionErrorCodec = Profunctor.dimap toVariant fromVariant $ CJ.Variant.variantMatch + { invalidTag: Right $ CJ.named "Tag" $ CJ.Record.object + { name: CJ.string + , sha: CJ.string + , url: CJ.string } , disabledVersion: Left unit - , invalidManifest: Right $ CA.Record.object "LegacyManifestValidationError" + , invalidManifest: Right $ CJ.named "LegacyManifestValidationError" $ CJ.Record.object { error: Legacy.Manifest.legacyManifestErrorCodec - , reason: CA.string + , reason: CJ.string } - , unregisteredDependencies: Right (CA.array PackageName.codec) + , unregisteredDependencies: Right (CJ.array PackageName.codec) } where toVariant = case _ of @@ -542,7 +541,7 @@ validateVersion tag = } type EXCEPT_PACKAGE :: Row (Type -> Type) -> Row (Type -> Type) -type EXCEPT_PACKAGE r = (exceptPackage :: Except PackageValidationError | r) +type EXCEPT_PACKAGE r = (exceptPackage :: Run.Except.Except PackageValidationError | r) _exceptPackage = Proxy :: Proxy "exceptPackage" @@ -595,7 +594,7 @@ fetchPackageTags address = GitHub.listTags address >>= case _ of let reason = "GitHub API error with status code " <> show apiError.statusCode throwPackage { error, reason } _ -> - Except.throw $ String.joinWith "\n" + Run.Except.throw $ String.joinWith "\n" [ "Unexpected GitHub error with a status <= 400" , Octokit.printGitHubError err ] @@ -666,11 +665,11 @@ type JsonValidationError = , reason :: String } -jsonValidationErrorCodec :: JsonCodec JsonValidationError -jsonValidationErrorCodec = CA.Record.object "JsonValidationError" - { tag: CA.string - , value: CA.Record.optional CA.string - , reason: CA.string +jsonValidationErrorCodec :: CJ.Codec JsonValidationError +jsonValidationErrorCodec = CJ.named "JsonValidationError" $ CJ.Record.object + { tag: CJ.string + , value: CJ.Record.optional CJ.string + , reason: CJ.string } formatPackageValidationError :: PackageValidationError -> JsonValidationError @@ -852,10 +851,10 @@ instance MemoryEncodable ImportCache where instance FsEncodable ImportCache where encodeFs = case _ of ImportManifest name (RawVersion version) next -> do - let codec = CA.Common.either versionValidationErrorCodec Manifest.codec + let codec = CJ.Common.either versionValidationErrorCodec Manifest.codec Exists.mkExists $ AsJson ("ImportManifest__" <> PackageName.print name <> "__" <> version) codec next PublishFailure name version next -> do - let codec = CA.string + let codec = CJ.string Exists.mkExists $ AsJson ("PublishFailureCache__" <> PackageName.print name <> "__" <> Version.print version) codec next type IMPORT_CACHE r = (importCache :: Cache ImportCache | r) diff --git a/scripts/src/PackageDeleter.purs b/scripts/src/PackageDeleter.purs index 1e868ee00..0bcacc643 100644 --- a/scripts/src/PackageDeleter.purs +++ b/scripts/src/PackageDeleter.purs @@ -6,7 +6,7 @@ import ArgParse.Basic (ArgParser) import ArgParse.Basic as Arg import Control.Apply (lift2) import Data.Array as Array -import Data.Codec.Argonaut as CA +import Data.Codec.JSON as CJ import Data.FoldableWithIndex (foldMapWithIndex) import Data.Formatter.DateTime as Formatter.DateTime import Data.Map as Map @@ -52,8 +52,8 @@ derive instance Eq InputMode type DeletePackages = Map PackageName (Array Version) -deletePackagesCodec :: JsonCodec DeletePackages -deletePackagesCodec = Internal.Codec.packageMap (CA.array Version.codec) +deletePackagesCodec :: CJ.Codec DeletePackages +deletePackagesCodec = Internal.Codec.packageMap (CJ.array Version.codec) parser :: ArgParser Arguments parser = Arg.fromRecord diff --git a/scripts/src/PackageTransferrer.purs b/scripts/src/PackageTransferrer.purs index d0c25e074..d203c66de 100644 --- a/scripts/src/PackageTransferrer.purs +++ b/scripts/src/PackageTransferrer.purs @@ -3,8 +3,9 @@ module Registry.Scripts.PackageTransferrer where import Registry.App.Prelude import Data.Array as Array -import Data.Codec.Argonaut.Common as CA.Common -import Data.Codec.Argonaut.Record as CA.Record +import Data.Codec.JSON as CJ +import Data.Codec.JSON.Common as CJ.Common +import Data.Codec.JSON.Record as CJ.Record import Data.Formatter.DateTime as Formatter.DateTime import Data.Map as Map import Data.String as String @@ -104,7 +105,7 @@ transfer = do case Map.size needsTransfer of 0 -> Log.info "No packages require transferring." n -> do - Log.info $ Array.fold [ show n, " packages need transferring: ", printJson (CA.Common.strMap packageLocationsCodec) needsTransfer ] + Log.info $ Array.fold [ show n, " packages need transferring: ", printJson (CJ.Common.strMap packageLocationsCodec) needsTransfer ] _ <- transferAll packages needsTransfer Log.info "Completed transfers!" @@ -145,8 +146,8 @@ type PackageLocations = , tagLocation :: Location } -packageLocationsCodec :: JsonCodec PackageLocations -packageLocationsCodec = CA.Record.object "PackageLocations" +packageLocationsCodec :: CJ.Codec PackageLocations +packageLocationsCodec = CJ.named "PackageLocations" $ CJ.Record.object { registeredLocation: Location.codec , tagLocation: Location.codec } diff --git a/scripts/src/Solver.purs b/scripts/src/Solver.purs index 53dfc5b4d..ffd66dbd2 100644 --- a/scripts/src/Solver.purs +++ b/scripts/src/Solver.purs @@ -11,9 +11,8 @@ module Registry.Scripts.Solver where import Registry.App.Prelude -import Data.Argonaut.Core as Json import Data.Array as Array -import Data.Codec.Argonaut as J +import Data.Codec.JSON as CJ import Data.DateTime.Instant as Instant import Data.Foldable (foldMap) import Data.Formatter.DateTime as Formatter.DateTime @@ -24,6 +23,7 @@ import Data.Time.Duration (Milliseconds(..)) import Effect.Class.Console as Aff import Effect.Exception (throw) import Effect.Now (now) +import JSON as JSON import Node.Path as Path import Node.Process as Node.Process import Node.Process as Process @@ -81,7 +81,7 @@ main = launchAff_ do parser = Range.parser <|> (Version.parser <#> \v -> unsafeFromJust (Range.mk v (Version.bumpPatch v))) parsing = hush <<< flip Parsing.runParser parser - codec = Codec.packageMap $ J.prismaticCodec "VersionOrRange" parsing Range.print J.string + codec = Codec.packageMap $ CJ.prismaticCodec "VersionOrRange" parsing Range.print CJ.string package = unsafeFromRight $ PackageName.parse "manifest" version = unsafeFromRight $ Version.parse "0.0.0" deps <- liftAff (readJsonFile codec path) >>= case _ of @@ -165,7 +165,7 @@ main = launchAff_ do Log.debug $ "Took: " <> show d <> "ms" case r of Right vs -> - Log.debug $ Json.stringifyWithIndent 2 (J.encode (Codec.packageMap Version.codec) vs) + Log.debug $ JSON.printIndented (CJ.encode (Codec.packageMap Version.codec) vs) Left es -> do Log.error $ "Failed: " <> PackageName.print package <> "@" <> Version.print version Log.warn $ String.take 5000 $ foldMap Solver.printSolverError es diff --git a/scripts/src/VerifyIntegrity.purs b/scripts/src/VerifyIntegrity.purs index 423c2002a..97aef379c 100644 --- a/scripts/src/VerifyIntegrity.purs +++ b/scripts/src/VerifyIntegrity.purs @@ -7,7 +7,7 @@ import ArgParse.Basic (ArgParser) import ArgParse.Basic as Arg import Control.Apply (lift2) import Data.Array as Array -import Data.Codec.Argonaut as CA +import Data.Codec.JSON as CJ import Data.Either (isLeft) import Data.Foldable (class Foldable, foldMap, intercalate) import Data.Formatter.DateTime as Formatter.DateTime @@ -102,7 +102,7 @@ main = launchAff_ do -- --package name@version Package name -> pure (Just [ name ]) -- --file packagesversions.json - File path -> liftAff (readJsonFile (CA.array PackageName.codec) path) >>= case _ of + File path -> liftAff (readJsonFile (CJ.array PackageName.codec) path) >>= case _ of Left err -> Console.log err *> liftEffect (Process.exit' 1) Right values -> pure (Just values) All -> pure Nothing diff --git a/spago.lock b/spago.lock index fbb6510bb..75d0acb28 100644 --- a/spago.lock +++ b/spago.lock @@ -5,11 +5,11 @@ workspace: dependencies: - aff - ansi - - argonaut-core - arrays - b64 - bifunctors - - codec-argonaut + - codec + - codec-json - console - const - control @@ -23,6 +23,7 @@ workspace: - fetch - filterable - foldable-traversable + - foreign - foreign-object - formatters - http-methods @@ -33,9 +34,9 @@ workspace: - js-fetch - js-promise-aff - js-uri + - json - lists - maybe - - media-types - newtype - node-buffer - node-child-process @@ -53,7 +54,6 @@ workspace: - partial - prelude - profunctor - - profunctor-lenses - record - refs - registry-foreign @@ -76,15 +76,16 @@ workspace: dependencies: - aff - aff-promise - - argonaut-core - arrays - b64 - bifunctors - - codec-argonaut + - codec + - codec-json - convertable-options - datetime - effect - either + - exceptions - fetch - filterable - foldable-traversable @@ -93,6 +94,8 @@ workspace: - http-methods - integers - js-date + - js-fetch + - json - maybe - newtype - node-buffer @@ -103,10 +106,13 @@ workspace: - profunctor - registry-lib - strings + - transformers - tuples - unsafe-coerce - variant test_dependencies: + - node-child-process + - node-execa - node-fs - node-process - spec @@ -114,10 +120,10 @@ workspace: path: lib dependencies: - aff - - argonaut-core - arrays - bifunctors - - codec-argonaut + - codec + - codec-json - control - datetime - effect @@ -130,6 +136,7 @@ workspace: - functors - graphs - integers + - json - language-cst-parser - lists - maybe @@ -146,12 +153,13 @@ workspace: - profunctor-lenses - routing-duplex - safe-coerce + - st - strings - transformers - tuples test_dependencies: - - argonaut-core - exceptions + - json - node-child-process - node-execa - spec @@ -160,12 +168,10 @@ workspace: path: scripts dependencies: - aff - - argonaut-core - argparse-basic - arrays - - codec-argonaut + - codec-json - console - - control - datetime - either - exceptions @@ -173,8 +179,10 @@ workspace: - filterable - foldable-traversable - formatters + - json - lists - newtype + - node-fs - node-path - node-process - now @@ -195,6 +203,7 @@ workspace: package_set: registry: 46.0.0 extra_packages: + codec-json: 1.2.0 dodo-printer: repo: https://github.com/natefaubion/purescript-dodo-printer.git version: v2.2.1 @@ -290,22 +299,6 @@ packages: - foldable-traversable - lists - strings - argonaut-core: - type: registry - version: 7.0.0 - integrity: sha256-RC82GfAjItydxrO24cdX373KHVZiLqybu19b5X8u7B4= - dependencies: - - arrays - - control - - either - - foreign-object - - functions - - gen - - maybe - - nonempty - - prelude - - strings - - tailrec argparse-basic: type: registry version: 2.0.0 @@ -412,15 +405,16 @@ packages: dependencies: - bifunctors - profunctor - codec-argonaut: + codec-json: type: registry - version: 10.0.0 - integrity: sha256-n80U8KiBk333qfQwDobSZWiyNg9BA3CL/EwFznIdRwI= + version: 1.2.0 + integrity: sha256-59+uYYe/5uTFa/Q6EqF8ekvP/Y4SOjUNfwIqIYtNiGI= dependencies: - - argonaut-core - codec - foreign-object + - json - ordered-collections + - transformers - type-equality - variant console: @@ -941,6 +935,21 @@ packages: dependencies: - functions - maybe + json: + type: registry + version: 1.0.0 + integrity: sha256-UCHdePAoOD19UyCPLU97oZjcdxLlQZQneWFsfoUNNpE= + dependencies: + - either + - foldable-traversable + - functions + - gen + - integers + - maybe + - prelude + - strings + - tuples + - unfoldable justifill: type: registry version: 0.5.0 diff --git a/spago.yaml b/spago.yaml index 293af1d2b..74b14750a 100644 --- a/spago.yaml +++ b/spago.yaml @@ -3,6 +3,7 @@ workspace: package_set: registry: 46.0.0 extra_packages: + codec-json: 1.2.0 dodo-printer: repo: https://github.com/natefaubion/purescript-dodo-printer.git version: v2.2.1