resugar evaluated term

4 files changed, 12 insertions, 15 deletions

diff --git a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
index fd02ebe..e15dc00 100644
--- a/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
+++ b/lambda-calcul/haskell/src/Minilang/Lambda/Parser.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DeriveAnyClass #-}
 
 module Minilang.Lambda.Parser where
 
@@ -14,6 +15,8 @@ import qualified Minilang.Lambda.Eval as Eval
 import Text.Megaparsec (Parsec, between, empty, errorBundlePretty, parse, some, try)
 import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, symbolChar)
 import qualified Text.Megaparsec.Char.Lexer as L
+import GHC.Generics (Generic)
+import Data.Aeson (ToJSON, FromJSON)
 
 type Parser = Parsec Void Text
 
@@ -21,7 +24,7 @@ data ParseError = ParseError Text
   deriving (Eq, Show)
 
 data AST = Sym Text | Abs [Text] AST | App AST AST [AST]
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic, ToJSON, FromJSON)
 
 desugar :: AST -> Term
 desugar = \case
diff --git a/lambda-calcul/haskell/src/Minilang/REPL/Pure.hs b/lambda-calcul/haskell/src/Minilang/REPL/Pure.hs
index 91e71b9..7ca0c85 100644
--- a/lambda-calcul/haskell/src/Minilang/REPL/Pure.hs
+++ b/lambda-calcul/haskell/src/Minilang/REPL/Pure.hs
@@ -41,7 +41,7 @@ instance MonadREPL PureREPL where
 render :: Out -> Text
 render = \case
   Msg t -> t
-  Evaluated term typ -> pretty (resugar term) <> " : " <> Type.pretty typ
+  Evaluated ast _term typ -> pretty ast <> " : " <> Type.pretty typ
   Bye -> "Bye!"
   other -> pack (show other)
 
diff --git a/lambda-calcul/haskell/src/Minilang/REPL/Run.hs b/lambda-calcul/haskell/src/Minilang/REPL/Run.hs
index 37d4dd2..3984dec 100644
--- a/lambda-calcul/haskell/src/Minilang/REPL/Run.hs
+++ b/lambda-calcul/haskell/src/Minilang/REPL/Run.hs
@@ -15,7 +15,7 @@ import Minilang.Lambda.DeBruijn (eval, fromDeBruijn, toDeBruijn)
 import Minilang.Lambda.Eval (newEnv)
 import Minilang.Lambda.Infer (infer, newContext)
 import qualified Minilang.Lambda.Infer as Infer
-import Minilang.Lambda.Parser (desugar, parse)
+import Minilang.Lambda.Parser (desugar, parse, resugar)
 import Minilang.Lambda.Unify (Type (TyVar))
 import Minilang.REPL.Types
 
@@ -43,15 +43,16 @@ handleUserInput txt = do
     Right expr -> do
       let term = desugar expr
           v = fromDeBruijn $ eval (toDeBruijn term)
+          ast = resugar v
       case language of
         Typed ->
           case infer term of
             Left typeError -> output (Msg $ Infer.render typeError)
             Right typ -> do
               let
-              output (Evaluated v typ)
+              output (Evaluated ast v typ)
         Untyped ->
-          output (Evaluated v (TyVar "<?>"))
+          output (Evaluated ast v (TyVar "<?>"))
 
 handleCommand ::
   (MonadCatch m, MonadREPL m) =>
@@ -89,12 +90,4 @@ loadProgramInEnv prog = do
         Left typeError -> output (Msg $ pack $ show typeError)
         Right (term, typ, env', context') -> do
           setEnv (repl {env = env', context = context'})
-          output (Evaluated term typ)
-  where
-    makeMessage =
-      "Loaded \""
-        <> ( if Text.length prog > 15
-               then Text.take 15 prog <> "..."
-               else prog
-           )
-        <> "\""
+          output (Evaluated (resugar term) term typ)
diff --git a/lambda-calcul/haskell/src/Minilang/REPL/Types.hs b/lambda-calcul/haskell/src/Minilang/REPL/Types.hs
index 61e92e0..74cf028 100644
--- a/lambda-calcul/haskell/src/Minilang/REPL/Types.hs
+++ b/lambda-calcul/haskell/src/Minilang/REPL/Types.hs
@@ -11,6 +11,7 @@ import Minilang.Lambda.Eval (Env, Term, newEnv)
 import Minilang.Lambda.Infer (Context, newContext)
 import Minilang.Lambda.Unify (Type)
 import Text.Read (readMaybe)
+import Minilang.Lambda.Parser (AST)
 
 class (Monad m) => MonadREPL m where
   -- | Returns the current environment for this session
@@ -76,7 +77,7 @@ data Content
 
 data Out
   = Defined Text Term
-  | Evaluated Term Type
+  | Evaluated AST Term Type
   | CurrentEnv Env Context Language
   | Msg Text
   | Bye