chore: Re-format Haskell code (#1219)

* chore: Re-format Haskell code

* fix: Re-add comment

src/Concretize.hs

@@ -11,6 +11,7 @@ import Data.Maybe (fromMaybe)
 import Debug.Trace
 import Env (envIsExternal, findPoly, getTypeBinder, getValue, insert, insertX, lookupEverywhere, searchValue)
 import Info
+import InitialTypes
 import Managed
 import qualified Map
 import Obj
@@ -27,7 +28,6 @@ import TypesToC
 import Util
 import Validate
 import Prelude hiding (lookup)
-import InitialTypes
 
 data Level = Toplevel | Inside
 
@@ -89,8 +89,8 @@ concretizeXObj allowAmbiguityRoot typeEnv rootEnv visitedDefinitions root =
             envWithArgs =
               foldl'
                 ( \e arg@(XObj (Sym path _) _ _) ->
-                -- n.b. this won't fail since we're inserting unqualified args into a fresh env
-                -- TODO: Still, it'd be nicer and more flexible to catch failures here.
+                    -- n.b. this won't fail since we're inserting unqualified args into a fresh env
+                    -- TODO: Still, it'd be nicer and more flexible to catch failures here.
                     let Right v = insertX e path arg in v
                 )
                 functionEnv
@@ -490,12 +490,12 @@ renameGenericTypeSymbolsOnSum varpairs x@(XObj (Lst (caseNm : caseMembers)) i t)
   where
     mapp = Map.fromList varpairs
     replacer mem@(XObj (Sym (SymPath [] name) _) _ _) =
-       let Just perhapsTyVar = xobjToTy mem
-        in if isFullyGenericType perhapsTyVar
-           then case Map.lookup (VarTy name) mapp of
-                  Just new -> reify new
-                  _ -> mem
-           else mem
+      let Just perhapsTyVar = xobjToTy mem
+       in if isFullyGenericType perhapsTyVar
+            then case Map.lookup (VarTy name) mapp of
+              Just new -> reify new
+              _ -> mem
+            else mem
     replacer y = y
 renameGenericTypeSymbolsOnSum _ x = x
 
@@ -503,11 +503,12 @@ renameGenericTypeSymbolsOnSum _ x = x
 renameGenericTypeSymbolsOnProduct :: [Ty] -> [XObj] -> [XObj]
 renameGenericTypeSymbolsOnProduct vars members =
   concatMap (\(var, (v, t)) -> [v, rename var t]) (zip vars (pairwise members))
-  where rename var mem =
-          let Just perhapsTyVar = xobjToTy mem
-           in if isFullyGenericType perhapsTyVar
-              then reify var
-              else mem
+  where
+    rename var mem =
+      let Just perhapsTyVar = xobjToTy mem
+       in if isFullyGenericType perhapsTyVar
+            then reify var
+            else mem
 
 -- | Given an generic struct type and a concrete version of it, generate all dependencies needed to use the concrete one.
 -- TODO: Handle polymorphic constructors (a b).
@@ -525,9 +526,9 @@ instantiateGenericStructType typeEnv originalStructTy@(StructTy _ _) genericStru
               nameFixedMembers = renameGenericTypeSymbolsOnProduct renamedOrig memberXObjs
               validMembers = replaceGenericTypeSymbolsOnMembers mapp nameFixedMembers
               concretelyTypedMembers = replaceGenericTypeSymbolsOnMembers mappings memberXObjs
-           -- We only used the renamed types for validation--passing the
-           -- renamed xobjs further down leads to syntactical issues.
-           in case validateMembers typeEnv renamedOrig validMembers of
+           in -- We only used the renamed types for validation--passing the
+              -- renamed xobjs further down leads to syntactical issues.
+              case validateMembers typeEnv renamedOrig validMembers of
                 Left err -> Left err
                 Right () ->
                   let deps = mapM (depsForStructMemberPair typeEnv) (pairwise concretelyTypedMembers)

src/Eval.hs

@@ -42,7 +42,7 @@ data LookupPreference
   = PreferDynamic
   | PreferGlobal
   | PreferLocal [SymPath]
-  deriving Show
+  deriving (Show)
 
 data Resolver
   = ResolveGlobal
@@ -78,7 +78,7 @@ eval ctx xobj@(XObj o info ty) preference resolver =
       pure $
         case resolver of
           ResolveGlobal -> unwrapLookup ((tryAllLookups preference) >>= checkStatic)
-          ResolveLocal  -> unwrapLookup (tryAllLookups preference)
+          ResolveLocal -> unwrapLookup (tryAllLookups preference)
       where
         checkStatic v@(_, Right (XObj (Lst ((XObj obj _ _) : _)) _ _)) =
           if isResolvableStaticObj obj
@@ -89,30 +89,34 @@ eval ctx xobj@(XObj o info ty) preference resolver =
         unwrapLookup =
           fromMaybe
             (throwErr (SymbolNotFound spath) ctx info)
-        -- | Try all lookups performs lookups for symbols based on a given
+        -- Try all lookups performs lookups for symbols based on a given
         -- lookup preference.
         tryAllLookups :: LookupPreference -> Maybe (Context, Either EvalError XObj)
         tryAllLookups PreferDynamic = (getDynamic) <|> fullLookup
-        tryAllLookups PreferGlobal  = (getGlobal spath) <|> fullLookup
+        tryAllLookups PreferGlobal = (getGlobal spath) <|> fullLookup
         tryAllLookups (PreferLocal shadows) = (if spath `elem` shadows then (getLocal n) else (getDynamic)) <|> fullLookup
         fullLookup = (tryDynamicLookup <|> (if null p then tryInternalLookup spath <|> tryLookup spath else tryLookup spath))
         getDynamic :: Maybe (Context, Either EvalError XObj)
         getDynamic =
-          do (Binder _ found) <- maybeId (E.findValueBinder (contextGlobalEnv ctx) (SymPath ("Dynamic" : p) n))
-             pure (ctx, Right (resolveDef found))
+          do
+            (Binder _ found) <- maybeId (E.findValueBinder (contextGlobalEnv ctx) (SymPath ("Dynamic" : p) n))
+            pure (ctx, Right (resolveDef found))
         getGlobal :: SymPath -> Maybe (Context, Either EvalError XObj)
         getGlobal path =
-          do (Binder meta found) <- maybeId (E.findValueBinder (contextGlobalEnv ctx) path)
-             checkPrivate meta found
+          do
+            (Binder meta found) <- maybeId (E.findValueBinder (contextGlobalEnv ctx) path)
+            checkPrivate meta found
         tryDynamicLookup :: Maybe (Context, Either EvalError XObj)
         tryDynamicLookup =
-          do (Binder meta found) <- maybeId (E.searchValueBinder (contextGlobalEnv ctx) (SymPath ("Dynamic" : p) n))
-             checkPrivate meta found
+          do
+            (Binder meta found) <- maybeId (E.searchValueBinder (contextGlobalEnv ctx) (SymPath ("Dynamic" : p) n))
+            checkPrivate meta found
         getLocal :: String -> Maybe (Context, Either EvalError XObj)
         getLocal name =
-           do internal <- contextInternalEnv ctx
-              (Binder _ found) <- maybeId (E.getValueBinder internal name)
-              pure (ctx, Right (resolveDef found))
+          do
+            internal <- contextInternalEnv ctx
+            (Binder _ found) <- maybeId (E.getValueBinder internal name)
+            pure (ctx, Right (resolveDef found))
         -- TODO: Deprecate this function?
         -- The behavior here is a bit nefarious since it relies on cached
         -- environment parents (it calls `search` on the "internal" binder).
@@ -446,7 +450,7 @@ macroExpand ctx xobj =
             ok <- expanded
             Right (XObj (StaticArr ok) i t)
         )
-    XObj (Lst (XObj (Sym (SymPath [] "defmodule") _) _ _: _)) _ _ ->
+    XObj (Lst (XObj (Sym (SymPath [] "defmodule") _) _ _ : _)) _ _ ->
       pure (ctx, Right xobj)
     XObj (Lst [XObj (Sym (SymPath [] "quote") _) _ _, _]) _ _ ->
       pure (ctx, Right xobj)
@@ -1091,9 +1095,11 @@ specialCommandSet ctx [orig@(XObj (Sym path@(SymPath _ _) _) _ _), val] =
               case result of
                 Right evald -> typeCheckValueAgainstBinder newCtx evald binder >>= \(nctx, typedVal) -> setter nctx env typedVal binder
                 left -> pure (newCtx, left)
-      where handleUnTyped :: IO (Context, Either EvalError XObj)
-            handleUnTyped = evalDynamic ResolveLocal ctx val
-                              >>= \(newCtx, result) -> setter newCtx env result binder
+      where
+        handleUnTyped :: IO (Context, Either EvalError XObj)
+        handleUnTyped =
+          evalDynamic ResolveLocal ctx val
+            >>= \(newCtx, result) -> setter newCtx env result binder
     setGlobal :: Context -> Env -> Either EvalError XObj -> Binder -> IO (Context, Either EvalError XObj)
     setGlobal ctx' env value binder =
       pure $ either (failure ctx' orig) (success ctx') value

src/Expand.hs

@@ -1,16 +1,16 @@
 module Expand (expandAll, replaceSourceInfoOnXObj) where
 
+import Context
 import Control.Monad.State (State, evalState, get, put)
 import Data.Foldable (foldlM)
 import Env
+import EvalError
 import Info
 import Obj
+import Qualify
 import TypeError
 import Types
 import Util
-import Context
-import Qualify
-import EvalError
 
 -- | Used for calling back to the 'eval' function in Eval.hs
 type DynamicEvaluator = Context -> XObj -> IO (Context, Either EvalError XObj)

src/InitialTypes.hs

@@ -117,15 +117,16 @@ initialTypes typeEnv rootEnv root = evalState (visit rootEnv root) 0
       unknown -> pure (Left (InvalidObj unknown xobj))
     visitSymbol :: Env -> XObj -> SymPath -> State Integer (Either TypeError XObj)
     visitSymbol e xobj@(XObj (Sym name LookupRecursive) _ _) _ =
-        case E.searchValueBinder e name of
-          -- If this recursive symbol is already typed in this environment, use that type.
-          -- This is relevant for, e.g. recursive function calls.
-          -- We need to use search here to check parents as our let-binding handling possibly puts recursive
-          -- environments as the parent of a more local environment for the let bindings.
-          Right (Binder _ found) -> pure (Right xobj {xobjTy = xobjTy found})
-          -- Other recursive lookups are left untouched (this avoids problems with looking up the thing they're referring to)
-          Left _ -> do freshTy <- genVarTy
-                       pure (Right xobj {xobjTy = Just freshTy})
+      case E.searchValueBinder e name of
+        -- If this recursive symbol is already typed in this environment, use that type.
+        -- This is relevant for, e.g. recursive function calls.
+        -- We need to use search here to check parents as our let-binding handling possibly puts recursive
+        -- environments as the parent of a more local environment for the let bindings.
+        Right (Binder _ found) -> pure (Right xobj {xobjTy = xobjTy found})
+        -- Other recursive lookups are left untouched (this avoids problems with looking up the thing they're referring to)
+        Left _ -> do
+          freshTy <- genVarTy
+          pure (Right xobj {xobjTy = Just freshTy})
     visitSymbol env xobj symPath =
       case symPath of
         -- Symbols with leading ? are 'holes'.

src/Primitives.hs

@@ -646,8 +646,8 @@ primitiveUse xobj ctx (XObj (Sym path _) _ _) =
       -- Look up the module to see if we can actually use it.
       -- The reference might be contextual, if so, append the current context path strings.
       path' = case (searchValueBinder global path) of
-              Right _ -> path
-              _ -> contextualized
+        Right _ -> path
+        _ -> contextualized
    in pure
         ( case modulePath of
             (SymPath [] "") -> updateGlobalUsePaths global path'