Refactor using Either

swarm-game · Jun 19, 2024 · e9f6dbf · e9f6dbf
1 parent ba18450
commit e9f6dbf
Show file tree

Hide file tree

Showing 3 changed files with 15 additions and 21 deletions.
diff --git a/src/swarm-tui/Swarm/TUI/Controller.hs b/src/swarm-tui/Swarm/TUI/Controller.hs
@@ -1320,15 +1320,14 @@ validateREPLForm s =
               (theType, errSrcLoc) = case readTerm' defaultParserConfig uinput of
                 Left err ->
                   let ((_y1, x1), (_y2, x2), _msg) = showErrorPos err
-                   in (Nothing, SrcLoc x1 x2)
-                Right Nothing -> (Nothing, NoLoc)
+                   in (Nothing, Left (SrcLoc x1 x2))
+                Right Nothing -> (Nothing, Right ())
                 Right (Just theTerm) -> case processParsedTerm' ctxs theTerm of
-                  Right t -> (Just (t ^. processedSyntax . sType), NoLoc)
-                  Left err -> (Nothing, cteSrcLoc err)
+                  Right t -> (Just (t ^. processedSyntax . sType), Right ())
+                  Left err -> (Nothing, Left (cteSrcLoc err))
            in s
-                & uiState . uiGameplay . uiREPL . replValid .~ isJust theType
+                & uiState . uiGameplay . uiREPL . replValid .~ errSrcLoc
                 & uiState . uiGameplay . uiREPL . replType .~ theType
-                & uiState . uiGameplay . uiREPL . replErrorSrcLoc .~ errSrcLoc
     SearchPrompt _ -> s
  where
   uinput = s ^. uiState . uiGameplay . uiREPL . replPromptText

diff --git a/src/swarm-tui/Swarm/TUI/Model/Repl.hs b/src/swarm-tui/Swarm/TUI/Model/Repl.hs
@@ -38,7 +38,6 @@ module Swarm.TUI.Model.Repl (
   replPromptEditor,
   replPromptText,
   replValid,
-  replErrorSrcLoc,
   replLast,
   replType,
   replControlMode,
@@ -276,8 +275,7 @@ data ReplControlMode
 data REPLState = REPLState
   { _replPromptType :: REPLPrompt
   , _replPromptEditor :: Editor Text Name
-  , _replValid :: Bool
-  , _replErrorSrcLoc :: SrcLoc
+  , _replValid :: Either SrcLoc ()
   , _replLast :: Text
   , _replType :: Maybe Polytype
   , _replControlMode :: ReplControlMode
@@ -296,8 +294,7 @@ initREPLState hist =
   REPLState
     { _replPromptType = defaultPrompt
     , _replPromptEditor = newREPLEditor ""
-    , _replValid = True
-    , _replErrorSrcLoc = NoLoc
+    , _replValid = Right ()
     , _replLast = ""
     , _replType = Nothing
     , _replControlMode = Typing
@@ -321,10 +318,9 @@ replPromptText = lens g s
   s r t = r & replPromptEditor .~ newREPLEditor t
 
 -- | Whether the prompt text is a valid 'Swarm.Language.Syntax.Term'.
-replValid :: Lens' REPLState Bool
-
--- | Where in the prompt text is an invalid 'Swarm.Language.Syntax.Term'.
-replErrorSrcLoc :: Lens' REPLState SrcLoc
+--   If it is invalid, the location of error. ('NoLoc' means the whole
+--   text causes the error.)
+replValid :: Lens' REPLState (Either SrcLoc ())
 
 -- | The type of the current REPL input which should be displayed to
 --   the user (if any).

diff --git a/src/swarm-tui/Swarm/TUI/View.hs b/src/swarm-tui/Swarm/TUI/View.hs
@@ -1541,12 +1541,11 @@ renderREPLPrompt focus theRepl = ps1 <+> replE
   prompt = theRepl ^. replPromptType
   replEditor = theRepl ^. replPromptEditor
   color t =
-    if theRepl ^. replValid
-      then txt t
-      else case theRepl ^. replErrorSrcLoc of
-        NoLoc -> withAttr redAttr (txt t)
-        SrcLoc s e | s == e || s >= T.length t -> withAttr redAttr (txt t)
-        SrcLoc s e ->
+    case theRepl ^. replValid of
+      Right () -> txt t
+      Left NoLoc -> withAttr redAttr (txt t)
+      Left (SrcLoc s e) | s == e || s >= T.length t -> withAttr redAttr (txt t)
+      Left (SrcLoc s e) ->
           let (validL, (invalid, validR)) = T.splitAt (e - s) <$> T.splitAt s t
            in hBox [txt validL, withAttr redAttr (txt invalid), txt validR]
   ps1 = replPromptAsWidget (T.concat $ getEditContents replEditor) prompt