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