diff --git a/ci/build.sh b/ci/build.sh index b1e04a73..86fc032a 100755 --- a/ci/build.sh +++ b/ci/build.sh @@ -13,8 +13,7 @@ case $COMPONENT in cd client npm install # Use production config, since we want to use these bundles for deploys - npm config set trypurescript-client:configpath "config/prod/*.purs" - npm run build + npm run build:production ;; *) echo >&2 "Unrecognised component: $COMPONENT" diff --git a/client/.travis.yml b/client/.travis.yml index 754de2b2..32d9b31a 100644 --- a/client/.travis.yml +++ b/client/.travis.yml @@ -1,10 +1,10 @@ language: node_js -dist: trusty +dist: bionic sudo: required -node_js: 6 +node_js: 12 install: - npm install -g bower - npm install - bower install --production script: - - npm run -s bundle + - npm run -s test diff --git a/client/package.json b/client/package.json index 489b488c..92539edd 100644 --- a/client/package.json +++ b/client/package.json @@ -6,9 +6,9 @@ }, "scripts": { "clean": "rimraf output", - "test": "spago test --path $npm_package_config_configpath", - "build": "spago build --path $npm_package_config_configpath", - "bundle": "spago bundle-app --path $npm_package_config_configpath --purs-args '--censor-lib --strict' --to public/js/index.js" + "test": "spago test --path config/dev/Try.Config.purs", + "build": "spago build --path config/dev/Try.Config.purs", + "build:production": "spago bundle-app --path config/prod/Try.Config.purs --purs-args '--censor-lib --strict' --to public/js/index.js" }, "devDependencies": { "purescript": "^0.13.6", diff --git a/client/spago.dhall b/client/spago.dhall index a21cdeea..2d1e8b70 100644 --- a/client/spago.dhall +++ b/client/spago.dhall @@ -6,25 +6,19 @@ You can edit this file as you like. , dependencies = [ "aff" , "affjax" + , "argonaut-codecs" , "arrays" , "assert" , "bifunctors" , "console" , "const" - , "contravariant" , "control" , "debug" - , "distributive" , "effect" , "either" - , "enums" , "exceptions" - , "exists" , "foldable-traversable" - , "foreign" - , "foreign-generic" , "foreign-object" - , "free" , "functions" , "functors" , "generics-rep" @@ -33,7 +27,6 @@ You can edit this file as you like. , "integers" , "jquery" , "js-timers" - , "lazy" , "math" , "maybe" , "node-fs" @@ -41,20 +34,14 @@ You can edit this file as you like. , "parallel" , "prelude" , "profunctor" - , "proxy" , "psci-support" - , "quickcheck" , "random" , "refs" , "semirings" - , "st" , "strings" - , "tailrec" , "transformers" , "tuples" - , "typelevel-prelude" , "unfoldable" - , "validation" , "web-html" ] , packages = ./packages.dhall diff --git a/client/src/Main.purs b/client/src/Main.purs index e44fddec..c7f04979 100644 --- a/client/src/Main.purs +++ b/client/src/Main.purs @@ -6,7 +6,7 @@ import Control.Monad.Except.Trans (runExceptT) import Data.Array (mapMaybe) import Data.Array as Array import Data.Either (Either(..)) -import Data.Foldable (elem, fold, for_, intercalate, traverse_) +import Data.Foldable (elem, fold, for_, intercalate) import Data.FoldableWithIndex (forWithIndex_) import Data.Maybe (Maybe(..), fromMaybe) import Effect (Effect) @@ -14,12 +14,11 @@ import Effect.Aff (Aff, launchAff_) import Effect.Class (liftEffect) import Effect.Console (error) import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn5, mkEffectFn1, runEffectFn1, runEffectFn2, runEffectFn5) -import Foreign (renderForeignError) import Foreign.Object (Object) import Foreign.Object as Object import JQuery as JQuery import JQuery.Extras as JQueryExtras -import Try.API (CompileError(..), CompileResult(..), CompileWarning(..), CompilerError(..), ErrorPosition(..), FailedResult(..), SuccessResult(..)) +import Try.API (CompileError(..), CompileResult(..), CompilerError) import Try.API as API import Try.Config as Config import Try.Gist (getGistById, tryLoadFileFromGist, uploadGist) @@ -43,7 +42,7 @@ displayErrors errs = do column2 <- JQuery.select "#column2" JQueryExtras.empty column2 - forWithIndex_ errs \i (CompilerError{ message }) -> do + forWithIndex_ errs \i { message } -> do h1 <- JQuery.create "

" JQuery.addClass "error-banner" h1 JQuery.setText ("Error " <> show (i + 1) <> " of " <> show (Array.length errs)) h1 @@ -140,7 +139,11 @@ compile = do liftEffect cleanUpMarkers case res of - Right (CompileSuccess (SuccessResult { js, warnings })) -> do + Left err -> liftEffect do + hideLoadingMessage + displayPlainText "Unable to parse the response from the server" + error err + Right (CompileSuccess { js, warnings }) -> do showJs <- liftEffect isShowJsChecked if showJs then liftEffect do hideLoadingMessage @@ -149,32 +152,32 @@ compile = do sources <- runExceptT $ runLoader loader (JS js) liftEffect hideLoadingMessage for_ warnings \warnings_ -> liftEffect do - let toAnnotation (CompileWarning{ errorCode, position, message }) = - position <#> \(ErrorPosition pos) -> - { row: pos.startLine - 1 - , column: pos.startColumn - 1 - , type: "warning" - , text: message - } + let + toAnnotation { errorCode, position, message } = + position <#> \pos -> + { row: pos.startLine - 1 + , column: pos.startColumn - 1 + , type: "warning" + , text: message + } runEffectFn1 setAnnotations (mapMaybe toAnnotation warnings_) for_ sources (liftEffect <<< execute (JS js)) - Right (CompileFailed (FailedResult { error })) -> liftEffect do + Right (CompileFailed { error }) -> liftEffect do hideLoadingMessage case error of CompilerErrors errs -> do displayErrors errs - - let toAnnotation (CompilerError{ position, message }) = - position <#> \(ErrorPosition pos) -> - { row: pos.startLine - 1 - , column: pos.startColumn - 1 - , type: "error" - , text: message - } + let + toAnnotation { position, message } = + position <#> \pos -> + { row: pos.startLine - 1 + , column: pos.startColumn - 1 + , type: "error" + , text: message + } runEffectFn1 setAnnotations (mapMaybe toAnnotation errs) - - for_ errs \(CompilerError{ position }) -> - for_ position \(ErrorPosition pos) -> + for_ errs \{ position } -> + for_ position \pos -> runEffectFn5 addMarker "error" pos.startLine @@ -182,10 +185,6 @@ compile = do pos.endLine pos.endColumn OtherError err -> displayPlainText err - Left errs -> liftEffect do - hideLoadingMessage - displayPlainText "Unable to parse the response from the server" - traverse_ (error <<< renderForeignError) errs -- | Execute the compiled code in a new iframe. execute :: JS -> Object JS -> Effect Unit diff --git a/client/src/Try/API.purs b/client/src/Try/API.purs index 2f470704..9a40c475 100644 --- a/client/src/Try/API.purs +++ b/client/src/Try/API.purs @@ -19,100 +19,63 @@ import Affjax.RequestBody as AXRB import Affjax.ResponseFormat as AXRF import Affjax.StatusCode (StatusCode(..)) import Control.Alt ((<|>)) -import Control.Monad.Except (ExceptT(..), runExcept) +import Control.Monad.Except (ExceptT(..)) +import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.:)) +import Data.Argonaut.Encode (encodeJson) import Data.Either (Either(..)) -import Data.Generic.Rep (class Generic) -import Data.List.NonEmpty (NonEmptyList) import Data.Maybe (Maybe(..)) +import Data.Traversable (traverse) import Effect.Aff (Aff) -import Foreign (ForeignError, unsafeToForeign) -import Foreign.Class (class Decode, decode) -import Foreign.Generic (defaultOptions, genericDecode) -import Foreign.Generic.Class (Options, SumEncoding(..)) - -decodingOptions :: Options -decodingOptions = defaultOptions { unwrapSingleConstructors = true } -- | The range of text associated with an error -newtype ErrorPosition = ErrorPosition +type ErrorPosition = { startLine :: Int , endLine :: Int , startColumn :: Int , endColumn :: Int } -derive instance genericErrorPosition :: Generic ErrorPosition _ - -instance decodeErrorPosition :: Decode ErrorPosition where - decode = genericDecode decodingOptions - -newtype CompilerError = CompilerError +type CompilerError = { message :: String , position :: Maybe ErrorPosition } -derive instance genericCompilerError :: Generic CompilerError _ - -instance decodeCompilerError :: Decode CompilerError where - decode = genericDecode decodingOptions - -- | An error reported from the compile API. data CompileError = CompilerErrors (Array CompilerError) | OtherError String -derive instance genericCompileError :: Generic CompileError _ - -instance decodeCompileError :: Decode CompileError where - decode = genericDecode - (defaultOptions - { sumEncoding = - TaggedObject - { tagFieldName: "tag" - , contentsFieldName: "contents" - , constructorTagTransform: identity - } - }) - -newtype Suggestion = Suggestion +instance decodeJsonCompileError :: DecodeJson CompileError where + decodeJson = decodeJson >=> \obj -> do + contents <- obj .: "contents" + obj .: "tag" >>= case _ of + "OtherError" -> + map OtherError $ decodeJson contents + "CompilerErrors" -> + map CompilerErrors $ traverse decodeJson =<< decodeJson contents + _ -> + Left "Tag must be one of: OtherError, CompilerErrors" + +type Suggestion = { replacement :: String , replaceRange :: Maybe ErrorPosition } -derive instance genericSuggestion :: Generic Suggestion _ - -instance decodeSuggestion :: Decode Suggestion where - decode = genericDecode decodingOptions - -newtype CompileWarning = CompileWarning +type CompileWarning = { errorCode :: String , message :: String , position :: Maybe ErrorPosition , suggestion :: Maybe Suggestion } -derive instance genericCompileWarning :: Generic CompileWarning _ - -instance decodeCompileWarning :: Decode CompileWarning where - decode = genericDecode decodingOptions - -newtype SuccessResult = SuccessResult +type SuccessResult = { js :: String , warnings :: Maybe (Array CompileWarning) } -derive instance genericSuccessResult :: Generic SuccessResult _ - -instance decodeSuccessResult :: Decode SuccessResult where - decode = genericDecode decodingOptions - -newtype FailedResult = FailedResult - { error :: CompileError } - -derive instance genericFailedResult :: Generic FailedResult _ - -instance decodeFailedResult :: Decode FailedResult where - decode = genericDecode decodingOptions +type FailedResult = + { error :: CompileError + } -- | The result of calling the compile API. data CompileResult @@ -120,10 +83,10 @@ data CompileResult | CompileFailed FailedResult -- | Parse the result from the compile API and verify it -instance decodeCompileResult :: Decode CompileResult where - decode f = - CompileSuccess <$> genericDecode decodingOptions f - <|> CompileFailed <$> genericDecode decodingOptions f +instance decodeJsonCompileResult :: DecodeJson CompileResult where + decodeJson json = + map CompileSuccess (decodeJson json) + <|> map CompileFailed (decodeJson json) get :: URL -> ExceptT String Aff String get url = ExceptT $ AX.get AXRF.string url >>= case _ of @@ -135,13 +98,13 @@ get url = ExceptT $ AX.get AXRF.string url >>= case _ of pure $ Right body -- | POST the specified code to the Try PureScript API, and wait for a response. -compile :: String -> String -> ExceptT String Aff (Either (NonEmptyList ForeignError) CompileResult) -compile endpoint code = ExceptT $ AX.post AXRF.json (endpoint <> "/compile") (Just requestBody) >>= case _ of +compile :: String -> String -> ExceptT String Aff (Either String CompileResult) +compile endpoint code = ExceptT $ AX.post AXRF.json (endpoint <> "/compile") requestBody >>= case _ of Left e -> pure $ Left $ printError e Right { status } | status >= StatusCode 400 -> pure $ Left $ "Received error status code: " <> show status Right { body } -> - pure $ Right $ runExcept (decode (unsafeToForeign body)) + pure $ Right $ decodeJson body where - requestBody = AXRB.String code + requestBody = Just $ AXRB.Json $ encodeJson code diff --git a/client/src/Try/Gist.purs b/client/src/Try/Gist.purs index ac8abb4e..141260b1 100644 --- a/client/src/Try/Gist.purs +++ b/client/src/Try/Gist.purs @@ -14,12 +14,12 @@ import Affjax.ResponseFormat as AXRF import Affjax.StatusCode (StatusCode(..)) import Control.Monad.Except.Trans (ExceptT(..)) import Data.Argonaut.Core (Json, caseJsonObject, stringify, toString) +import Data.Argonaut.Encode (encodeJson) import Data.Either (Either(..)) import Data.Function.Uncurried (Fn2, runFn2) import Data.Maybe (Maybe(..)) import Data.Nullable (Nullable, toMaybe) import Effect.Aff (Aff) -import Foreign.Generic (encodeJSON) import Foreign.Object as Object import Unsafe.Coerce (unsafeCoerce) @@ -51,7 +51,7 @@ uploadGist content = ExceptT $ AX.post AXRF.json "https://api.github.com/gists" _ -> Left "Key id was not a string." where - requestBody = Just $ AXRB.string $ encodeJSON + requestBody = Just $ AXRB.json $ encodeJson { description: "Published with try.purescript.org" , public: false , files: { "Main.purs": { content } } diff --git a/client/src/Try/Types.purs b/client/src/Try/Types.purs index a85d2e8b..75d4e502 100644 --- a/client/src/Try/Types.purs +++ b/client/src/Try/Types.purs @@ -2,11 +2,10 @@ module Try.Types ( JS(..) ) where +import Data.Argonaut.Encode (class EncodeJson) import Data.Newtype (class Newtype) -import Foreign.Class (class Encode) newtype JS = JS String derive instance newtypeJS :: Newtype JS _ - -derive newtype instance encodeJS :: Encode JS +derive newtype instance encodeJsonJS :: EncodeJson JS diff --git a/client/test/Main.purs b/client/test/Main.purs index 9d4fb24c..2bc4ed27 100644 --- a/client/test/Main.purs +++ b/client/test/Main.purs @@ -2,17 +2,12 @@ module Test.Main where import Prelude -import Control.Monad.Except (runExceptT) import Data.Argonaut.Core (Json) +import Data.Argonaut.Decode (class DecodeJson, decodeJson) import Data.Bitraversable (ltraverse) import Data.Either (Either, isRight) -import Data.Identity (Identity(..)) -import Data.List.Types (NonEmptyList) -import Data.Newtype (un) import Effect (Effect) import Effect.Class.Console (log, logShow) -import Foreign (ForeignError, unsafeToForeign) -import Foreign.Generic (class Decode, decode) import Test.Assert (assert) import Test.Fixture.Json (Fixtures, readFixtures) import Try.API (CompileResult) @@ -30,14 +25,9 @@ apiTests fixtures = do shouldDecode (Proxy :: _ CompileResult) fixtures.compileSuccess -- | Test that a JSON response decodes successfully. -shouldDecode :: forall a. Decode a => Proxy a -> Json -> Effect Unit +shouldDecode :: forall a. DecodeJson a => Proxy a -> Json -> Effect Unit shouldDecode _ fixture = do - let - result :: Either (NonEmptyList ForeignError) a - result = un Identity $ runExceptT $ decode $ unsafeToForeign fixture - - _ <- result # ltraverse \errors -> do + result <- (decodeJson fixture :: Either String a) # ltraverse \errors -> do log "Failed to decode fixture:\n" logShow errors - assert (isRight result) diff --git a/server/Main.hs b/server/Main.hs index 009fb7c0..a66ce09a 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternGuards #-} module Main (main) where