Restyled by fourmolu

Author: restyled-commits

src/swarm-lang/Swarm/Language/LSP.hs

@@ -22,9 +22,9 @@ import Language.LSP.Protocol.Types qualified as LSP
 import Language.LSP.Server
 import Language.LSP.VFS (VirtualFile (..), virtualFileText)
 import Swarm.Failure (SystemFailure (..))
-import Swarm.Language.Load (SyntaxWithImports (..))
 import Swarm.Language.LSP.Hover qualified as H
 import Swarm.Language.LSP.VarUsage qualified as VU
+import Swarm.Language.Load (SyntaxWithImports (..))
 import Swarm.Language.Parser.Util (getLocRange)
 import Swarm.Language.Pipeline (processSource)
 import Swarm.Language.Syntax (SrcLoc (..), eraseRaw)

src/swarm-lang/Swarm/Language/Load.hs

@@ -35,7 +35,7 @@ import Swarm.Language.Parser.Core (defaultParserConfig, importLoc)
 import Swarm.Language.Syntax
 import Swarm.Language.Syntax.Import hiding (ImportPhase (..))
 import Swarm.Language.Syntax.Import qualified as Import
-import Swarm.Language.Syntax.Util (Erasable(..))
+import Swarm.Language.Syntax.Util (Erasable (..))
 import Swarm.Language.Types (TCtx, UCtx)
 import Swarm.Pretty (prettyText)
 import Swarm.Util (readFileMayT, showT)
@@ -174,7 +174,7 @@ resolveImport parent loc = do
 
   srcMap <- get @(SourceMap Resolved)
   resMod <- case M.lookup canonicalLoc srcMap of
-    Just m -> pure m    -- Already loaded - do nothing
+    Just m -> pure m -- Already loaded - do nothing
     Nothing -> do
       -- Record this import loc in the source map using a temporary, empty module,
       -- to prevent it from attempting to load itself recursively
@@ -206,17 +206,17 @@ resolveImport parent loc = do
 --   evaluating them once.
 validateImport :: forall sig m. (Has (Throw SystemFailure) sig m) => ResLoc -> Module Resolved -> m ()
 validateImport loc = maybe (pure ()) validate . moduleTerm
-  where
-    validate :: Syntax Resolved -> m ()
-    validate = validateTerm . _sTerm
-
-    validateTerm :: Term Resolved -> m ()
-    validateTerm = \case
-      SLet LSDef _ _ _ _ _ _ t -> validate t
-      SImportIn _ t -> validate t
-      STydef _ _ _ t -> validate t
-      TConst Noop -> pure ()
-      t -> throwError $ ImpureImport loc (prettyText t)
+ where
+  validate :: Syntax Resolved -> m ()
+  validate = validateTerm . _sTerm
+
+  validateTerm :: Term Resolved -> m ()
+  validateTerm = \case
+    SLet LSDef _ _ _ _ _ _ t -> validate t
+    SImportIn _ t -> validate t
+    STydef _ _ _ t -> validate t
+    TConst Noop -> pure ()
+    t -> throwError $ ImpureImport loc (prettyText t)
 
 -- | Try to read and parse a term from a specific import location,
 --   either over the network or on disk.
@@ -233,7 +233,6 @@ readLoc loc = do
 
   -- Try to read the file from network/disk, depending on the anchor
   src <- case importAnchor loc of
-
     -- Read from network
     Web_ {} -> do
       -- Try to parse the URL

src/swarm-lang/Swarm/Language/Parser/Value.hs

@@ -51,8 +51,9 @@ readValue ty txt = do
   -- encountered; we can't read those anyway.
   sResolved <- eitherToMaybe . run . runError @SystemFailure $ resolve' s
   -- Now, make sure the resolved term typechecks at the given type.
-  _ <- eitherToMaybe . runError @ContextualTypeErr $
-    checkTop Ctx.empty Ctx.empty emptyTDCtx M.empty sResolved ty
+  _ <-
+    eitherToMaybe . runError @ContextualTypeErr $
+      checkTop Ctx.empty Ctx.empty emptyTDCtx M.empty sResolved ty
   -- Finally, turn the term into a value.
   toValue $ s ^. sTerm
 

src/swarm-lang/Swarm/Language/Typecheck.hs

@@ -885,19 +885,19 @@ inferTop ::
   Has (Error ContextualTypeErr) sig m =>
   TCtx -> ReqCtx -> TDCtx -> SourceMap Resolved -> Syntax Resolved -> m (SyntaxWithImports Typed)
 inferTop ctx reqCtx tdCtx srcMap =
-  fmap (uncurry SyntaxWithImports) .
-  runTC ctx reqCtx tdCtx Ctx.empty srcMap .
-  infer
+  fmap (uncurry SyntaxWithImports)
+    . runTC ctx reqCtx tdCtx Ctx.empty srcMap
+    . infer
 
 -- | Top level type checking function.
 checkTop ::
   Has (Error ContextualTypeErr) sig m =>
   TCtx -> ReqCtx -> TDCtx -> SourceMap Resolved -> Syntax Resolved -> Type -> m (SyntaxWithImports Typed)
 checkTop ctx reqCtx tdCtx srcMap t =
-  fmap (uncurry SyntaxWithImports) .
-  runTC ctx reqCtx tdCtx Ctx.empty srcMap .
-  check t .
-  toU
+  fmap (uncurry SyntaxWithImports)
+    . runTC ctx reqCtx tdCtx Ctx.empty srcMap
+    . check t
+    . toU
 
 -- | Infer the type of a term, returning a type-annotated term.
 --

src/swarm-lang/Swarm/Language/Value.hs

@@ -178,7 +178,7 @@ makeLenses ''Env
 
 -- | Create an environment which is empty except for an initial SourceMap.
 envFromSrcMap :: SourceMap Elaborated -> Env
-envFromSrcMap srcMap = emptyEnv { _envSourceMap = srcMap }
+envFromSrcMap srcMap = emptyEnv {_envSourceMap = srcMap}
 
 emptyEnv :: Env
 emptyEnv = Env Ctx.empty Ctx.empty Ctx.empty emptyTDCtx M.empty

src/swarm-tui/Swarm/TUI/Controller.hs

@@ -890,7 +890,7 @@ validateREPLForm s =
               (theType, errSrcLoc) = case readTerm' defaultParserConfig uinput of
                 Left err ->
                   let (((_y1, x1), (_y2, x2)), _msg) = showErrorPos err
-                  in (Nothing, Left (SrcLoc Nothing x1 x2))
+                   in (Nothing, Left (SrcLoc Nothing x1 x2))
                 Right Nothing -> (Nothing, Right ())
                 Right (Just theTerm) ->
                   -- Explicitly ignore REPL entries with imports,
@@ -899,15 +899,15 @@ validateREPLForm s =
                   -- be properly resolved and checked when the
                   -- user hits enter.
                   let res = run . runError @SystemFailure $ processTermNoImports uinput theTerm (Just env)
-                  in case res of
-                       Right t -> (Just (t ^. sType), Right ())
-                       Left (DoesNotTypecheck loc _) -> (Nothing, Left loc)
-                       -- Don't signal an error if the REPL entry contained an import
-                       Left (DisallowedImport _) -> (Nothing, Right ())
-                       _ -> (Nothing, Right ())
+                   in case res of
+                        Right t -> (Just (t ^. sType), Right ())
+                        Left (DoesNotTypecheck loc _) -> (Nothing, Left loc)
+                        -- Don't signal an error if the REPL entry contained an import
+                        Left (DisallowedImport _) -> (Nothing, Right ())
+                        _ -> (Nothing, Right ())
            in s
-            & uiGameplay . uiREPL . replValid .~ errSrcLoc
-            & uiGameplay . uiREPL . replType .~ theType
+                & uiGameplay . uiREPL . replValid .~ errSrcLoc
+                & uiGameplay . uiREPL . replType .~ theType
     SearchPrompt _ -> s
  where
   uinput = s ^. uiGameplay . uiREPL . replPromptText

src/swarm-util/Swarm/Failure.hs

@@ -165,8 +165,8 @@ instance PrettyPrec SystemFailure where
     DisallowedImport _imp -> "Import is not allowed here"
     ImpureImport imp t ->
       nest 2 . vcat $
-      [ "While processing import" <+> ppr imp <> ":"
-      , "Imported modules must only contain imports + definitions, but found:"
-      , squotes (pretty t)
-      ]
+        [ "While processing import" <+> ppr imp <> ":"
+        , "Imported modules must only contain imports + definitions, but found:"
+        , squotes (pretty t)
+        ]
     CustomFailure m -> pretty m

test/unit/TestLanguagePipeline.hs

@@ -17,8 +17,8 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as T
 import Swarm.Failure (SystemFailure)
-import Swarm.Language.Load (SyntaxWithImports (..))
 import Swarm.Language.JSON ()
+import Swarm.Language.Load (SyntaxWithImports (..))
 import Swarm.Language.Parser (readTerm)
 import Swarm.Language.Parser.QQ (tyQ)
 import Swarm.Language.Pipeline (processSource)
@@ -766,22 +766,22 @@ testLanguagePipeline =
         "Import #2540"
         [ testCase
             "simple import"
-            ( valid "import \"data/test/import/a.sw\"; pure (a + 1)" )
+            (valid "import \"data/test/import/a.sw\"; pure (a + 1)")
         , testCase
             "recursive import - unused"
-            ( valid "import \"data/test/import/b.sw\"; pure (b + 1)" )
+            (valid "import \"data/test/import/b.sw\"; pure (b + 1)")
         , testCase
             "recursive import - used"
-            ( valid "import \"data/test/import/d.sw\"; pure (d + 1)" )
+            (valid "import \"data/test/import/d.sw\"; pure (d + 1)")
         , testCase
             "recursive import is not re-exported"
             ( process
-               "import \"data/test/import/f.sw\"; pure (f + g)"
-               "1:43: Unbound variable g"
+                "import \"data/test/import/f.sw\"; pure (f + g)"
+                "1:43: Unbound variable g"
             )
         , testCase
             "import from URL"
-            ( valid "import \"https://raw.githubusercontent.com/byorgey/swarm-defs/refs/heads/main/defs.sw\"; tL")
+            (valid "import \"https://raw.githubusercontent.com/byorgey/swarm-defs/refs/heads/main/defs.sw\"; tL")
         ]
     ]
  where
@@ -791,15 +791,16 @@ testLanguagePipeline =
   process = processCompare T.isPrefixOf
 
   processCompare :: (Text -> Text -> Bool) -> Text -> Text -> Assertion
-  processCompare cmp code expect = runError @SystemFailure (processSource code Nothing) >>= \case
-    Left e
-      | not (T.null expect) && cmp expect (prettyText e) -> pure ()
-      | otherwise ->
-          error $
-            "Unexpected failure:\n\n  " <> show (prettyText e) <> "\n\nExpected:\n\n  " <> show expect <> "\n"
-    Right _
-      | expect == "" -> pure ()
-      | otherwise -> error "Unexpected success"
+  processCompare cmp code expect =
+    runError @SystemFailure (processSource code Nothing) >>= \case
+      Left e
+        | not (T.null expect) && cmp expect (prettyText e) -> pure ()
+        | otherwise ->
+            error $
+              "Unexpected failure:\n\n  " <> show (prettyText e) <> "\n\nExpected:\n\n  " <> show expect <> "\n"
+      Right _
+        | expect == "" -> pure ()
+        | otherwise -> error "Unexpected success"
 
 -- | Check round tripping of term from and to text, then test ToJSON/FromJSON.
 roundTripTerm :: Text -> Assertion

test/unit/TestUtil.hs

@@ -9,7 +9,7 @@ module TestUtil where
 
 import Control.Carrier.Error.Either (runError)
 import Control.Lens (Ixed (ix), to, use, (&), (.~), (^.), (^?))
-import Control.Monad ((<=<), void)
+import Control.Monad (void, (<=<))
 import Control.Monad.State (StateT (..), execState)
 import Control.Monad.Trans (lift)
 import Data.Bifunctor (first)
@@ -37,8 +37,9 @@ eval :: GameState -> Text -> IO (GameState, Robot Instantiated, Either Text (Val
 eval g = either (return . (g,hypotheticalRobot undefined 0,) . Left) (evalPT g) <=< processTerm1
 
 processTerm1 :: Text -> IO (Either Text (SyntaxWithImports Elaborated))
-processTerm1 txt = fmap (first prettyText) . runError @SystemFailure $
-  processSource txt Nothing >>= requireNonEmptyTerm
+processTerm1 txt =
+  fmap (first prettyText) . runError @SystemFailure $
+    processSource txt Nothing >>= requireNonEmptyTerm
 
 evalPT :: GameState -> SyntaxWithImports Elaborated -> IO (GameState, Robot Instantiated, Either Text (Value, Int))
 evalPT g t = evalCESK g (initMachine t)
@@ -84,6 +85,7 @@ playUntilDone rid = do
     Nothing -> return $ Left . T.pack $ "The robot with ID " <> show rid <> " is nowhere to be found!"
 
 check :: Text -> (SyntaxWithImports Elaborated -> Bool) -> Assertion
-check code expect = processTerm1 code >>= \case
-  Left err -> assertFailure $ "Term processing failed: " ++ into @String err
-  Right t -> assertBool "Predicate was false!" (expect t)
+check code expect =
+  processTerm1 code >>= \case
+    Left err -> assertFailure $ "Term processing failed: " ++ into @String err
+    Right t -> assertBool "Predicate was false!" (expect t)