(_,_,errs) -> putStrLn $ "Input error: " ++ concat errs ++ "\n" ++
usageInfo usage options
+shrink :: String -> String
+shrink s = s -- if length s > 1000 then take 1000 s ++ "..." else s
+
-- Initialize the main loop
initLoop :: [Flag] -> FilePath -> History -> IO ()
initLoop flags f hist = do
putStrLn $ "Resolver failed: " ++ err
runInputT (settings []) (putHistory hist >> loop flags f [] TC.verboseEnv)
Right (adefs,names) -> do
- (merr,tenv) <- TC.runDeclss TC.verboseEnv adefs
+ (merr,tenv) <-
+ TC.runDeclss TC.verboseEnv (takeWhile (\x -> fst (head x) /= "stop") adefs)
case merr of
- Just err -> putStrLn $ "Type checking failed: " ++ err
+ Just err -> putStrLn $ "Type checking failed: " ++ shrink err
Nothing -> putStrLn "File loaded."
-- Compute names for auto completion
runInputT (settings [n | (n,_) <- names]) (putHistory hist >> loop flags f names tenv)
let e = mod $ E.eval (TC.env tenv) body
-- Let's not crash if the evaluation raises an error:
- liftIO $ catch (putStrLn (msg ++ show e))
+ liftIO $ catch (putStrLn (msg ++ shrink (show e)))
(\e -> putStrLn ("Exception: " ++
show (e :: SomeException)))
stop <- liftIO getCurrentTime