Skip to content

Commit

Permalink
Port from codec-argonaut to codec-json (#690)
Browse files Browse the repository at this point in the history
  • Loading branch information
f-f authored Jun 8, 2024
1 parent c36b378 commit be0d7ff
Show file tree
Hide file tree
Showing 52 changed files with 776 additions and 665 deletions.
1 change: 1 addition & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -17,3 +17,4 @@ result

# Keep it secret, keep it safe.
.env
.envrc
14 changes: 7 additions & 7 deletions app/spago.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -8,11 +8,11 @@ package:
dependencies:
- aff
- ansi
- argonaut-core
- arrays
- b64
- bifunctors
- codec-argonaut
- codec
- codec-json
- console
- const
- control
Expand All @@ -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
Expand All @@ -56,7 +57,6 @@ package:
- partial
- prelude
- profunctor
- profunctor-lenses
- record
- refs
- registry-foreign
Expand Down
21 changes: 11 additions & 10 deletions app/src/App/API.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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"
, "```"
Expand All @@ -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
--
Expand Down
15 changes: 8 additions & 7 deletions app/src/App/CLI/Licensee.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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.
Expand Down
39 changes: 20 additions & 19 deletions app/src/App/CLI/Purs.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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(..))
Expand All @@ -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 =
Expand All @@ -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.
Expand Down Expand Up @@ -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 })
Expand All @@ -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
13 changes: 7 additions & 6 deletions app/src/App/Effect/Cache.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
41 changes: 21 additions & 20 deletions app/src/App/Effect/GitHub.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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..."
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
}
Loading

0 comments on commit be0d7ff

Please sign in to comment.