From 0369f556e281cbda185722fa9e8766b2d83aface Mon Sep 17 00:00:00 2001 From: Matei Adriel Date: Thu, 9 Jul 2020 19:41:41 +0300 Subject: [PATCH] feat: show warnings in the problems tab --- public/styles/pages/editor/problems.scss | 5 ++ public/styles/theme.scss | 3 + src/Component/Editor.purs | 29 +++---- src/Component/Editor/Problems.purs | 104 ++++++++++++++++------- src/Data/Dataflow/Expression/Lint.purs | 11 ++- src/Data/Editor/State.purs | 49 ++++++----- 6 files changed, 125 insertions(+), 76 deletions(-) diff --git a/public/styles/pages/editor/problems.scss b/public/styles/pages/editor/problems.scss index cbbb5cc..6a04926 100644 --- a/public/styles/pages/editor/problems.scss +++ b/public/styles/pages/editor/problems.scss @@ -46,6 +46,11 @@ color: $error-text; } +.problems__card--warning { + background: $warning-bg; + color: $warning-text; +} + .problems__card-message { grid-row-start: 2; grid-column: 1 / 3; diff --git a/public/styles/theme.scss b/public/styles/theme.scss index 4913f8d..7af642e 100644 --- a/public/styles/theme.scss +++ b/public/styles/theme.scss @@ -18,4 +18,7 @@ $blue: #2667ff; $error-bg: #290000; $error-text: #df6d6d; +$warning-bg: #332b00; +$warning-text: #ffdd9e; + $transition-time: 0.2s; diff --git a/src/Component/Editor.purs b/src/Component/Editor.purs index 168844c..0ebbb25 100644 --- a/src/Component/Editor.purs +++ b/src/Component/Editor.purs @@ -61,6 +61,7 @@ import Lunarbox.Data.Route (Route(..)) import Lunarbox.Data.Set (toNative) as Set import Lunarbox.Foreign.Render (centerNode, centerOutput, setUnconnectableInputs, setUnconnectableOutputs) import Lunarbox.Foreign.Render as Native +import Record as Record import Web.Event.Event (preventDefault, stopPropagation) import Web.Event.Event as Event import Web.HTML (window) as Web @@ -139,12 +140,8 @@ pendingConnectionModal = , title: "Confirm connection" , content: HH.text "Connecting those nodes would change the type of this function creating a type error." , buttons: - [ { text: "Autofix" + [ { text: "Continue" , primary: true - , value: AutofixConnection - } - , { text: "Continue" - , primary: false , value: ProceedConnecting } , { text: "Cancel" @@ -283,7 +280,6 @@ component = liftAff $ delay interval name <- gets $ view _name if String.length name >= 2 then do - { errors, expression, typeMap } <- get newState <- gets stateToJson raise $ Save newState handleAction $ Autosave newState @@ -305,11 +301,10 @@ component = CreateConnection from toId toIndex -> do state <- createConnection from toId toIndex <$> get let - { expression, typeMap, errors } = tryCompiling state - case errors of + compilationResult = tryCompiling state + case compilationResult.typeErrors of [] -> do - put $ evaluate $ state { expression = expression, typeMap = typeMap, errors = errors } - printString "Created connection with no errors" + put $ evaluate $ Record.merge compilationResult state void updateAll _ -> do modify_ @@ -319,9 +314,7 @@ component = { from , toId , toIndex - , expression - , errors - , typeMap + , compilationResult } } handleAction (HandleConnectionConfirmation ProceedConnecting) @@ -345,16 +338,14 @@ component = HandleConnectionConfirmation other -> do p <- gets _.pendingConnection gets _.pendingConnection - >>= traverse_ \{ from, toId, toIndex, errors, expression, typeMap } -> case other of + >>= traverse_ \{ from, toId, toIndex, compilationResult } -> case other of ProceedConnecting -> do state <- get put $ createConnection from toId toIndex + $ Record.merge compilationResult $ state { pendingConnection = Nothing - , errors = errors - , typeMap = typeMap - , expression = expression } void updateAll handleAction Rerender @@ -442,7 +433,7 @@ component = ] panel :: State Action ChildSlots m -> Array (HH.ComponentHTML Action ChildSlots m) - panel { currentTab, project, currentFunction, functionData, typeMap, inputCountMap, name, isExample, isVisible, isAdmin, nodeSearchTerm, errors } = case currentTab of + panel { currentTab, project, currentFunction, functionData, typeMap, inputCountMap, name, isExample, isVisible, isAdmin, nodeSearchTerm, typeErrors, lintingErrors } = case currentTab of Settings -> mkPanel { title: "Project settings" @@ -541,7 +532,7 @@ component = , actions: [] , footer: Nothing , header: Nothing - , content: [ problems { typeErrors: errors, navigateTo: MoveTo } ] + , content: [ problems { typeErrors, lintingErrors, navigateTo: MoveTo } ] } scene :: HH.ComponentHTML Action ChildSlots m diff --git a/src/Component/Editor/Problems.purs b/src/Component/Editor/Problems.purs index b037eea..f64de3b 100644 --- a/src/Component/Editor/Problems.purs +++ b/src/Component/Editor/Problems.purs @@ -1,53 +1,93 @@ module Lunarbox.Component.Editor.Problems where import Prelude -import Data.Filterable (filterMap) import Data.Maybe (Maybe(..)) import Halogen.HTML as HH import Halogen.HTML.Events (onClick) import Lunarbox.Component.Icon (icon) -import Lunarbox.Component.Utils (className) -import Lunarbox.Data.Dataflow.TypeError (TypeError, getLocation, printError) +import Lunarbox.Component.Utils (className, whenElem) +import Lunarbox.Data.Dataflow.Expression.Lint (LintError) +import Lunarbox.Data.Dataflow.Expression.Lint as LintError +import Lunarbox.Data.Dataflow.TypeError (TypeError) +import Lunarbox.Data.Dataflow.TypeError as TypeError import Lunarbox.Data.Editor.Location (Location(..)) -import Lunarbox.Data.String (toHtml) type ProblemsInput a = { typeErrors :: Array (TypeError Location) + , lintingErrors :: Array (LintError Location) , navigateTo :: Location -> a } -- Icons -error :: forall h a. HH.HTML h a -error = icon "error" +errorIcon :: forall h a. HH.HTML h a +errorIcon = icon "error" -warning :: forall h a. HH.HTML h a -warning = icon "warning" +warningIcon :: forall h a. HH.HTML h a +warningIcon = icon "warning" -- The actual component problems :: forall h a. ProblemsInput a -> HH.HTML h a -problems { typeErrors: [] } = HH.main [ className "problems__empty" ] [ HH.text "No errors here!" ] +problems { typeErrors: [], lintingErrors: [] } = HH.main [ className "problems__empty" ] [ HH.text "No errors here!" ] -problems { typeErrors, navigateTo } = +problems { typeErrors, lintingErrors, navigateTo } = HH.main [ className "problems__container" ] - $ filterMap - ( \{ typeError, location } -> - if location == UnknownLocation then - Nothing - else - Just - $ HH.section [ className "problems__card problems__card--error" ] - [ HH.div [ className "problems__card-header" ] - [ HH.div [ className "problems__card-icon" ] [ error ] - , HH.button - [ className "problems__card-location" - , onClick $ const $ Just $ navigateTo location - ] - [ HH.text $ show location - ] - ] - , HH.div [ className "problems__card-message" ] - [ toHtml $ printError typeError ] - ] - ) - $ (\typeError -> { typeError, location: getLocation typeError }) - <$> typeErrors + $ typeErrorHtml + <> lintingErrorHtml + where + mkProblem = createProblemMaker navigateTo + + typeErrorHtml = + ( \error -> + mkProblem + { level: Error + , message: TypeError.printError error + , location: TypeError.getLocation error + } + ) + <$> typeErrors + + lintingErrorHtml = + ( \error -> + mkProblem + { level: Warning + , message: "not here yet" + , location: LintError.getLocation error + } + ) + <$> lintingErrors + +-- | Data about how to color a problem +data ProblemLevel + = Warning + | Error + +type ProblemConfig + = { level :: ProblemLevel, message :: String, location :: Location + } + +-- | Create the html for a problem +createProblemMaker :: forall h a. (Location -> a) -> ProblemConfig -> HH.HTML h a +createProblemMaker navigateTo { location, message, level } = + whenElem (location /= UnknownLocation) \_ -> + HH.section + [ className $ "problems__card " + <> case level of + Warning -> "problems__card--warning" + Error -> "problems__card--error" + ] + [ HH.div [ className "problems__card-header" ] + [ HH.div [ className "problems__card-icon" ] + [ case level of + Warning -> warningIcon + Error -> errorIcon + ] + , HH.button + [ className "problems__card-location" + , onClick $ const $ Just $ navigateTo location + ] + [ HH.text $ show location + ] + ] + , HH.div [ className "problems__card-message" ] + [ HH.text message ] + ] diff --git a/src/Data/Dataflow/Expression/Lint.purs b/src/Data/Dataflow/Expression/Lint.purs index 9af963a..48c20b3 100644 --- a/src/Data/Dataflow/Expression/Lint.purs +++ b/src/Data/Dataflow/Expression/Lint.purs @@ -4,17 +4,24 @@ import Prelude import Data.Array as Array import Lunarbox.Data.Dataflow.Expression (Expression(..), VarName, foldExpression) +-- | Basically warnings the user gets for imrpoving code clarity data LintError l - = UnusedDeclaration VarName l + = UnusedDeclaration l VarName | UnsaturatedFunction l l +-- | Get the location a linting error came from +getLocation :: forall l. LintError l -> l +getLocation (UnusedDeclaration location _) = location + +getLocation (UnsaturatedFunction location _) = location + -- | Collect linting errors inside an expression lint :: forall l. Expression l -> Array (LintError l) lint = foldExpression go where go (Let location name _ body) | Array.null (references name body) = - [ UnusedDeclaration name location + [ UnusedDeclaration location name ] go (FunctionCall location _ (TypedHole argLocation)) = diff --git a/src/Data/Editor/State.purs b/src/Data/Editor/State.purs index 4964c00..be96e34 100644 --- a/src/Data/Editor/State.purs +++ b/src/Data/Editor/State.purs @@ -37,6 +37,7 @@ import Lunarbox.Control.Monad.Dataflow.Solve.SolveExpression (solveExpression) import Lunarbox.Control.Monad.Dataflow.Solve.Unify (canUnify) import Lunarbox.Data.Class.GraphRep (toGraph) import Lunarbox.Data.Dataflow.Expression (Expression(..)) +import Lunarbox.Data.Dataflow.Expression.Lint (LintError, lint) import Lunarbox.Data.Dataflow.Runtime (RuntimeValue) import Lunarbox.Data.Dataflow.Runtime.ValueMap (ValueMap(..)) import Lunarbox.Data.Dataflow.Type (Type(..), inputs) @@ -55,6 +56,8 @@ import Lunarbox.Data.Graph as G import Lunarbox.Data.Ord (sortBySearch) import Lunarbox.Foreign.Render (GeometryCache, ForeignTypeMap, emptyGeometryCache) import Lunarbox.Foreign.Render as Native +import Record as Record +import Type.Row (type (+)) import Web.Event.Event as Event import Web.Event.Internal.Types (Event) @@ -80,7 +83,8 @@ tabIcon = case _ of type CompilationResult r = ( expression :: Expression Location , typeMap :: Map Location Type - , errors :: Array (TypeError Location) + , typeErrors :: Array (TypeError Location) + , lintingErrors :: Array (LintError Location) | r ) @@ -97,7 +101,8 @@ type StatePermanentData r type State a s m = { | StatePermanentData - ( currentTab :: Tab + + CompilationResult + + ( currentTab :: Tab , functionData :: Map FunctionName FunctionData , panelIsOpen :: Boolean , valueMap :: ValueMap Location @@ -105,21 +110,16 @@ type State a s m , inputCountMap :: Map FunctionName Int , pendingConnection :: Maybe - { - | CompilationResult - ( from :: NodeId - , toId :: NodeId - , toIndex :: Int - ) + { from :: NodeId + , toId :: NodeId + , toIndex :: Int + , compilationResult :: { | CompilationResult () } } , name :: String , isExample :: Boolean , isAdmin :: Boolean , nodeSearchTerm :: String , isVisible :: Boolean - , expression :: Expression Location - , errors :: Array (TypeError Location) - , typeMap :: Map Location Type ) } @@ -146,7 +146,8 @@ emptyState = , isAdmin: false , isVisible: false , pendingConnection: Nothing - , errors: [] + , typeErrors: [] + , lintingErrors: [] } -- Helpers @@ -306,30 +307,32 @@ tryCompiling :: forall a s m. State a s m -> { | CompilationResult () } -tryCompiling state@{ project, expression, typeMap, errors } = { expression: expression', typeMap: typeMap', errors: errors' } +tryCompiling state@{ project, expression, typeMap, typeErrors, lintingErrors } = result where expression' = compileProject project - (Tuple typeMap' errors') = + result = -- we only run the type inference algorithm if the expression changed - if (expression == expression') then - Tuple typeMap errors + if expression == expression' then + { typeMap, typeErrors, lintingErrors, expression } else - Tuple typeMap' errors' + { expression: expression' + , typeMap: typeMap' + , typeErrors: errors' + , lintingErrors: lintingErrors' + } where + lintingErrors' = lint expression' + (Tuple typeMap' (SolveState { errors: errors' })) = solveExpression expression' -- Compile a project compile :: forall a s m. State a s m -> State a s m compile state = evaluate - $ state - { expression = expression - , typeMap = typeMap - , errors = errors - } + $ Record.merge overwrites state where - { expression, typeMap, errors } = tryCompiling state + overwrites = tryCompiling state -- Evaluate the current expression and write into the value map evaluate :: forall a s m. State a s m -> State a s m