Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Graceful error handling in daml repl #4673

Merged
merged 2 commits into from
Feb 24, 2020
Merged

Graceful error handling in daml repl #4673

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
4ae60ae
Graceful error handling in `daml repl`
cocreature Feb 24, 2020
524a66b
why is windows
cocreature Feb 24, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
93 changes: 63 additions & 30 deletions compiler/damlc/daml-compiler/src/DA/Daml/Compiler/Repl.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,27 +4,30 @@
module DA.Daml.Compiler.Repl (runRepl) where

import qualified "zip-archive" Codec.Archive.Zip as Zip
import Control.Exception
import Control.Exception hiding (TypeError)
import Control.Monad
import Control.Monad.Except
import Control.Monad.Trans.Maybe
import qualified DA.Daml.LF.Ast as LF
import qualified DA.Daml.LF.Proto3.Archive as LFArchive
import DA.Daml.LF.Reader (readDalfs, Dalfs(..))
import qualified DA.Daml.LF.ReplClient as ReplClient
import DA.Daml.LFConversion.UtilGHC
import DA.Daml.Options.Types
import qualified Data.ByteString.Lazy as BSL
import Data.Data (toConstr)
import Data.Foldable
import Data.Maybe
import qualified Data.NameMap as NM
import Data.Text (Text)
import qualified Data.Text as T
import Development.IDE.Core.API
import Development.IDE.Core.Rules
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.RuleTypes.Daml
import Development.IDE.Core.Shake
import Development.IDE.GHC.Util
import Development.IDE.Types.Location
import ErrUtils
import GHC
import HsExpr (Stmt, StmtLR(..), LHsExpr)
import HsExtension (GhcPs, GhcTc)
Expand All @@ -40,6 +43,25 @@ import System.IO.Error
import System.IO.Extra
import Type

data Error
= ParseError MsgDoc
| UnsupportedStatement String -- ^ E.g., pattern on the LHS
| TypeError -- ^ The actual error will be in the diagnostics
| ScriptError ReplClient.BackendError

renderError :: DynFlags -> Error -> IO ()
renderError dflags err = case err of
ParseError err ->
putStrLn (showSDoc dflags err)
(UnsupportedStatement str) ->
putStrLn ("Unsupported statement: " <> str)
TypeError ->
-- ^ The error will be displayed via diagnostics.
pure ()
(ScriptError _err) ->
-- ^ The error will be displayed by the script runner.
pure ()

-- | Split a statement into the name of the binder (patterns are not supported)
-- and the body. For unsupported statements we return `Nothing`.
splitStmt :: Stmt GhcPs (LHsExpr GhcPs) -> Maybe (Maybe Text, LHsExpr GhcPs)
Expand Down Expand Up @@ -67,6 +89,35 @@ runRepl opts mainDar replClient ideState = do
Right _ -> pure ()
go moduleNames 0 []
where
handleLine
:: [LF.ModuleName]
-> [(Text, Type)]
-> DynFlags
-> String
-> Int
-> IO (Either Error (Maybe Text, Type))
handleLine moduleNames binds dflags l i = runExceptT $ do
stmt <- case parseStatement l dflags of
POk _ lStmt -> pure (unLoc lStmt)
PFailed _ _ errMsg -> throwError (ParseError errMsg)
(mbBind, expr) <- maybe (throwError (UnsupportedStatement l)) pure (splitStmt stmt)
liftIO $ writeFileUTF8 (fromNormalizedFilePath $ lineFilePath i)
(renderModule dflags moduleNames i binds expr)
-- Useful for debugging, probably best to put it behind a --debug flag
-- rendered <- liftIO $readFileUTF8 (fromNormalizedFilePath $ lineFilePath i)
-- liftIO $ for_ (lines rendered) $ \line ->
-- hPutStrLn stderr ("> " <> line)
(lfMod, tmrModule -> tcMod) <-
maybe (throwError TypeError) pure =<< liftIO (runAction ideState $ runMaybeT $
(,) <$> useE GenerateDalf (lineFilePath i)
<*> useE TypeCheck (lineFilePath i))
-- Type of the statement so we can give it a type annotation
-- and avoid incurring a typeclass constraint.
stmtTy <- maybe (throwError TypeError) pure (exprTy $ tm_typechecked_source tcMod)
scriptRes <- liftIO $ ReplClient.runScript replClient (optDamlLfVersion opts) lfMod
case scriptRes of
Right _ -> pure (mbBind, stmtTy)
Left err -> throwError (ScriptError err)
go :: [LF.ModuleName] -> Int -> [(T.Text, Type)] -> IO ()
go moduleNames !i !binds = do
putStr "daml> "
Expand All @@ -75,36 +126,18 @@ runRepl opts mainDar replClient ideState = do
dflags <-
hsc_dflags . hscEnv <$>
runAction ideState (use_ GhcSession $ lineFilePath i)
POk _ (unLoc -> stmt) <- pure (parseStatement l dflags)
let !(mbBind, expr) = fromMaybe (fail ("Unsupported statement type: " <> show (toConstr stmt))) (splitStmt stmt)
writeFileUTF8 (fromNormalizedFilePath $ lineFilePath i)
(renderModule dflags moduleNames i binds expr)
-- Useful for debugging, probably best to put it behind a --debug flag
-- rendered <- readFileUTF8 (fromNormalizedFilePath $ lineFilePath i)
-- for_ (lines rendered) $ \line ->
-- hPutStrLn stderr ("> " <> line)

-- TODO Handle failures here cracefully instead of
-- tearing down the whole process.
Just lfMod <- runAction ideState $ use GenerateDalf (lineFilePath i)
Just (tmrModule -> tcMod) <- runAction ideState $ use TypeCheck (lineFilePath i)
-- We need type annotations to avoid things becoming polymorphic.
-- If we end up with a typeclass constraint on `expr` things
-- will go wrong.
Just ty <- pure $ exprTy $ tm_typechecked_source tcMod

r <- ReplClient.runScript replClient (optDamlLfVersion opts) lfMod
r <- handleLine moduleNames binds dflags l i
case r of
Right _ -> pure ()
Left err -> do
hPutStrLn stderr ("Script produced an error: " <> show err)
-- TODO don’t kill the whole process
exitFailure

let shadow bind
| Just newBind <- mbBind, bind == newBind = "_"
| otherwise = bind
go moduleNames (i + 1 :: Int) (map (\(bind, ty) -> (shadow bind, ty)) binds <> [(fromMaybe "_" mbBind, ty)])
renderError dflags err
-- If we get an error we don’t increment i and we
-- do not get a new binding
go moduleNames i binds
Right (mbBind, ty) -> do
let shadow bind
| Just newBind <- mbBind, bind == newBind = "_"
| otherwise = bind
go moduleNames (i + 1 :: Int) (map (\(bind, ty) -> (shadow bind, ty)) binds <> [(fromMaybe "_" mbBind, ty)])

exprTy :: LHsBinds GhcTc -> Maybe Type
exprTy binds = listToMaybe
Expand Down
38 changes: 38 additions & 0 deletions compiler/damlc/tests/src/DA/Test/Repl.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,44 @@ main = do
, input "debug x"
, matchOutput "^.*: 2$"
]
, testInteraction' "parse error"
[ input "eaiu\\1"
, matchOutput "^parse error.*$"
, input "debug 1"
, matchOutput "^.*: 1"
]
, testInteraction' "unsupported statement"
[ input "(x, y) <- pure (1, 2)"
, matchOutput "^Unsupported statement:.*$"
, input "debug 1"
, matchOutput "^.*: 1"
]
, testInteraction' "type error"
[ input "1"
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think it would be more intuitive if a raw, pure expression did not result in a type error, but instead caused a debug to be inserted automatically, turning it into a Script _ expression. I think we should try to reserve "type errors" in the repl for non-pure expressions (e.g. tried to use Update monad instead of Script monad), or for pure expressions that have type errors in them (e.g. passed an argument of the wrong type). This is way more work than should be in this PR, though.

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

(As for how to implement that, we could catch type errors with "expected Script", add a debug, and try again. Maybe that's kinda messy, but I think it would make the interface more accessible.)

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I fully agree that this would be a nicer UX! GHCi also prints the result if you have something of type IO a where a is an instance of Show (and not ()) which would be nice to have. It also has some magic defaulting to IOwhich makes things likepure 1work automagically (that’s the main reason why I currently have the type annotation toScript _`. Not sure how much more clever that is than typechecking twice and if it’s possible to adapt this for our usecase.

-- TODO Make this less noisy
, matchOutput "^File:.*$"
, matchOutput "^Hidden:.*$"
, matchOutput "^Range:.*$"
, matchOutput "^Source:.*$"
, matchOutput "^Severity:.*$"
, matchOutput "^Message:.*$"
, matchOutput "^.*error.*$"
, matchOutput "^.*expected type .Script _. with actual type .Int..*$"
, matchOutput "^.*$"
, matchOutput "^.*$"
, matchOutput "^.*$"
, matchOutput "^.*$"
, input "debug 1"
, matchOutput "^.*: 1"
]
, testInteraction' "script error"
[ input "alice <- allocateParty \"Alice\""
, input "bob <- allocateParty \"Bob\""
, input "submit alice (createCmd (T alice bob))"
, matchOutput "^.*Submit failed.*requires authorizers.*but only.*were given.*$"
, input "debug 1"
, matchOutput "^.*: 1"
]
]

testInteraction :: FilePath -> Int -> FilePath -> FilePath -> [Step] -> Assertion
Expand Down
1 change: 1 addition & 0 deletions compiler/repl-service/client/src/DA/Daml/LF/ReplClient.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ module DA.Daml.LF.ReplClient
, withReplClient
, loadPackage
, runScript
, BackendError
) where

import Control.Concurrent
Expand Down