Reformatting

Now I'm using ormolu instead of brittany for Haskell formatting
now. Figured I should just make all of these big changes at once.

1 files changed, 83 insertions, 100 deletions

diff --git a/Biz/Language/Bs/Eval.hs b/Biz/Language/Bs/Eval.hs
index 290170b..1198a3e 100644
--- a/Biz/Language/Bs/Eval.hs
+++ b/Biz/Language/Bs/Eval.hs
@@ -1,19 +1,21 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE NoImplicitPrelude #-}
-module Language.Bs.Eval (
-  evalText
-, evalFile
-, runParseTest
-, safeExec
-, runASTinEnv
-, basicEnv
-, fileToEvalForm
-, textToEvalForm
-, getFileContents
-) where
+
+module Language.Bs.Eval
+  ( evalText,
+    evalFile,
+    runParseTest,
+    safeExec,
+    runASTinEnv,
+    basicEnv,
+    fileToEvalForm,
+    textToEvalForm,
+    getFileContents,
+  )
+where
 
 import Control.Exception
 import Control.Monad.Reader
@@ -28,23 +30,25 @@ import Protolude
 import System.Directory
 
 funcEnv :: Map.Map T.Text Expr
-funcEnv = Map.fromList $ primEnv
-  <> [ ("read" , IFun $ IFunc $ unop readFn)
-     , ("parse", IFun $ IFunc $ unop parseFn)
-     , ("eval", IFun $ IFunc $ unop eval)
-     , ("show", IFun $ IFunc $ unop (return . Tape . ppexpr))
-     ]
+funcEnv =
+  Map.fromList $
+    primEnv
+      <> [ ("read", IFun $ IFunc $ unop readFn),
+           ("parse", IFun $ IFunc $ unop parseFn),
+           ("eval", IFun $ IFunc $ unop eval),
+           ("show", IFun $ IFunc $ unop (return . Tape . ppexpr))
+         ]
 
 basicEnv :: Env
 basicEnv = Env Map.empty funcEnv
 
 readFn :: Expr -> Eval Expr
 readFn (Tape txt) = lineToEvalForm txt
-readFn  val       = throw $ TypeMismatch "read expects string, instead got:" val
+readFn val = throw $ TypeMismatch "read expects string, instead got:" val
 
 parseFn :: Expr -> Eval Expr
 parseFn (Tape txt) = either (throw . ParseError . show) return $ readExpr txt
-parseFn val        = throw $ TypeMismatch "parse expects string, instead got:" val
+parseFn val = throw $ TypeMismatch "parse expects string, instead got:" val
 
 safeExec :: IO a -> IO (Either String a)
 safeExec m = do
@@ -63,13 +67,13 @@ runASTinEnv :: Env -> Eval b -> IO b
 runASTinEnv code action = runReaderT (unEval action) code
 
 lineToEvalForm :: T.Text -> Eval Expr
-lineToEvalForm input = either (throw . ParseError . show  )  eval $ readExpr input
+lineToEvalForm input = either (throw . ParseError . show) eval $ readExpr input
 
 evalFile :: FilePath -> T.Text -> IO () -- program file
 evalFile filePath fileExpr = (runASTinEnv basicEnv $ fileToEvalForm filePath fileExpr) >>= print
 
 fileToEvalForm :: FilePath -> T.Text -> Eval Expr
-fileToEvalForm filePath input = either (throw . ParseError . show )  evalBody $ readExprFile filePath input
+fileToEvalForm filePath input = either (throw . ParseError . show) evalBody $ readExprFile filePath input
 
 runParseTest :: T.Text -> T.Text -- for view AST
 runParseTest input = either (T.pack . show) (T.pack . show) $ readExpr input
@@ -77,23 +81,23 @@ runParseTest input = either (T.pack . show) (T.pack . show) $ readExpr input
 getFileContents :: FilePath -> IO T.Text
 getFileContents fname = do
   exists <- doesFileExist fname
-  if exists then TIO.readFile  fname else return "File does not exist."
+  if exists then TIO.readFile fname else return "File does not exist."
 
 textToEvalForm :: T.Text -> Eval Expr
-textToEvalForm input = either (throw . ParseError . show ) evalBody $ readExpr input
+textToEvalForm input = either (throw . ParseError . show) evalBody $ readExpr input
 
 evalText :: T.Text -> IO () --REPL
 evalText textExpr = do
   res <- runASTinEnv basicEnv $ textToEvalForm textExpr
   print res
 
-getVar :: Expr ->  Eval Expr
+getVar :: Expr -> Eval Expr
 getVar (Atom atom) = do
-  Env{..} <- ask
+  Env {..} <- ask
   case Map.lookup atom (Map.union fenv env) of -- lookup, but prefer functions
-      Just x  -> return x
-      Nothing -> throw $ UnboundVar atom
-getVar n = throw $ TypeMismatch  "failure to get variable: " n
+    Just x -> return x
+    Nothing -> throw $ UnboundVar atom
+getVar n = throw $ TypeMismatch "failure to get variable: " n
 
 ensureAtom :: Expr -> Eval Expr
 ensureAtom n@(Atom _) = return n
@@ -106,136 +110,115 @@ extractVar n = throw $ TypeMismatch "expected an atomic value" n
 
 getEven :: [t] -> [t]
 getEven [] = []
-getEven (x:xs) = x : getOdd xs
+getEven (x : xs) = x : getOdd xs
 
 getOdd :: [t] -> [t]
 getOdd [] = []
-getOdd (_:xs) = getEven xs
+getOdd (_ : xs) = getEven xs
 
 applyFunc :: Expr -> [Expr] -> [Expr] -> Eval Expr
 applyFunc expr params args = bindArgsEval params args expr
 
 bindArgsEval :: [Expr] -> [Expr] -> Expr -> Eval Expr
 bindArgsEval params args expr = do
-  Env{..} <- ask
-  let newVars = zipWith (\a b -> (extractVar a,b)) params args
+  Env {..} <- ask
+  let newVars = zipWith (\a b -> (extractVar a, b)) params args
   let (newEnv, newFenv) = Map.partition (not . isFunc) $ Map.fromList newVars
   local (const $ Env (newEnv <> env) (newFenv <> fenv)) $ eval expr
 
 isFunc :: Expr -> Bool
-isFunc (List ((Atom "lambda"):_)) = True
-isFunc _  = False
+isFunc (List ((Atom "lambda") : _)) = True
+isFunc _ = False
 
 eval :: Expr -> Eval Expr
 eval (List [Atom "dumpEnv", x]) = do
-  Env{..} <- ask
+  Env {..} <- ask
   liftIO $ print $ toList env
   liftIO $ print $ toList fenv
   eval x
-
-eval (Numb i)   = return $ Numb i
-eval (Tape s)   = return $ Tape s
-eval (Bool b)   = return $ Bool b
-eval (List [])  = return Nil
-eval Nil        = return Nil
+eval (Numb i) = return $ Numb i
+eval (Tape s) = return $ Tape s
+eval (Bool b) = return $ Bool b
+eval (List []) = return Nil
+eval Nil = return Nil
 eval n@(Atom _) = getVar n
-
-eval (List [Atom "showSF", rest])      = return . Tape . T.pack $ show rest
+eval (List [Atom "showSF", rest]) = return . Tape . T.pack $ show rest
 eval (List ((:) (Atom "showSF") rest)) = return . Tape . T.pack . show $ List rest
-
 eval (List [Atom "quote", val]) = return val
-
 eval (List [Atom "if", pred_, then_, else_]) = do
   ifRes <- eval pred_
   case ifRes of
-    (Bool True)  -> eval then_
+    (Bool True) -> eval then_
     (Bool False) -> eval else_
     _ ->
       throw $ BadSpecialForm "if's first arg must eval into a boolean"
-eval (List ( (:) (Atom "if") _)) =
+eval (List ((:) (Atom "if") _)) =
   throw $ BadSpecialForm "(if <bool> <s-expr> <s-expr>)"
-
 eval (List [Atom "begin", rest]) = evalBody rest
-eval (List ((:) (Atom "begin") rest )) = evalBody $ List rest
-
+eval (List ((:) (Atom "begin") rest)) = evalBody $ List rest
 -- top-level define
 -- TODO: how to make this eval correctly?
-eval (List [Atom "define", List (name:args), body]) = do
-  Env{..} <- ask
+eval (List [Atom "define", List (name : args), body]) = do
+  Env {..} <- ask
   _ <- eval body
-  bindArgsEval (name:args) [body] name
-
+  bindArgsEval (name : args) [body] name
 eval (List [Atom "define", name, body]) = do
-  Env{..} <- ask
+  Env {..} <- ask
   _ <- eval body
   bindArgsEval [name] [body] name
-
 eval (List [Atom "let", List pairs, expr]) = do
-  Env{..} <- ask
+  Env {..} <- ask
   atoms <- mapM ensureAtom $ getEven pairs
-  vals  <- mapM eval       $ getOdd  pairs
+  vals <- mapM eval $ getOdd pairs
   bindArgsEval atoms vals expr
-
-eval (List (Atom "let":_) ) =
+eval (List (Atom "let" : _)) =
   throw $ BadSpecialForm "let function expects list of parameters and S-Expression body\n(let <pairs> <s-expr>)"
-
-
 eval (List [Atom "lambda", List params, expr]) = do
   ctx <- ask
-  return  $ Func (IFunc $ applyFunc expr params) ctx
-eval (List (Atom "lambda":_) ) = throw $ BadSpecialForm "lambda function expects list of parameters and S-Expression body\n(lambda <params> <s-expr>)"
-
-
+  return $ Func (IFunc $ applyFunc expr params) ctx
+eval (List (Atom "lambda" : _)) = throw $ BadSpecialForm "lambda function expects list of parameters and S-Expression body\n(lambda <params> <s-expr>)"
 -- needed to get cadr, etc to work
-eval (List [Atom "cdr", List [Atom "quote", List (_:xs)]]) =
+eval (List [Atom "cdr", List [Atom "quote", List (_ : xs)]]) =
   return $ List xs
-eval (List [Atom "cdr", arg@(List (x:xs))]) =
+eval (List [Atom "cdr", arg@(List (x : xs))]) =
   case x of
-      -- proxy for if the list can be evaluated
-      Atom _ -> do
-        val <- eval arg
-        eval $ List [Atom "cdr", val]
-      _ -> return $ List xs
-
-
-eval (List [Atom "car", List [Atom "quote", List (x:_)]]) =
-  return $  x
-eval (List [Atom "car", arg@(List (x:_))]) =
+    -- proxy for if the list can be evaluated
+    Atom _ -> do
+      val <- eval arg
+      eval $ List [Atom "cdr", val]
+    _ -> return $ List xs
+eval (List [Atom "car", List [Atom "quote", List (x : _)]]) =
+  return $ x
+eval (List [Atom "car", arg@(List (x : _))]) =
   case x of
-      Atom _ -> do
-        val <- eval arg
-        eval $ List [Atom "car", val]
-      _ -> return $ x
-
-
+    Atom _ -> do
+      val <- eval arg
+      eval $ List [Atom "car", val]
+    _ -> return $ x
 eval (List ((:) x xs)) = do
-  Env{..} <- ask
+  Env {..} <- ask
   funVar <- eval x
   xVal <- mapM eval xs
   case funVar of
-      (IFun (IFunc internalFn)) ->
-          internalFn xVal
-
-      (Func (IFunc definedFn) (Env benv _)) ->
-          local (const $ Env benv fenv) $ definedFn xVal
-
-      _ ->
-          throw $ NotFunction funVar
+    (IFun (IFunc internalFn)) ->
+      internalFn xVal
+    (Func (IFunc definedFn) (Env benv _)) ->
+      local (const $ Env benv fenv) $ definedFn xVal
+    _ ->
+      throw $ NotFunction funVar
 
 updateEnv :: T.Text -> Expr -> Env -> Env
-updateEnv var e@(IFun _)   Env{..} = Env env $ Map.insert var e fenv
-updateEnv var e@(Func _ _) Env{..} = Env env $ Map.insert var e fenv
-updateEnv var e            Env{..} = Env (Map.insert var e env) fenv
+updateEnv var e@(IFun _) Env {..} = Env env $ Map.insert var e fenv
+updateEnv var e@(Func _ _) Env {..} = Env env $ Map.insert var e fenv
+updateEnv var e Env {..} = Env (Map.insert var e env) fenv
 
 evalBody :: Expr -> Eval Expr
 evalBody (List [List ((:) (Atom "define") [Atom var, defExpr]), rest]) = do
   evalVal <- eval defExpr
   ctx <- ask
   local (const $ updateEnv var evalVal ctx) $ eval rest
-
 evalBody (List ((:) (List ((:) (Atom "define") [Atom var, defExpr])) rest)) = do
   evalVal <- eval defExpr
   ctx <- ask
   local (const $ updateEnv var evalVal ctx) $ evalBody $ List rest
-
 evalBody x = eval x