diff options
Diffstat (limited to 'src/TestMode.hs')
| -rw-r--r-- | src/TestMode.hs | 37 |
1 files changed, 30 insertions, 7 deletions
diff --git a/src/TestMode.hs b/src/TestMode.hs index 90ccdae..ab938e6 100644 --- a/src/TestMode.hs +++ b/src/TestMode.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + module TestMode ( testMode, ) where @@ -14,6 +16,9 @@ import Data.Text.IO qualified as T import System.IO.Error +import Text.Megaparsec.Error +import Text.Megaparsec.Pos + import Output import Parser import Run @@ -86,13 +91,31 @@ commands = cmdLoad :: Command cmdLoad = do [ path ] <- asks tmiParams - ( modules, allModules ) <- liftIO $ parseTestFiles [ T.unpack path ] - let globalDefs = evalGlobalDefs $ concatMap (\m -> map (first ( moduleName m, )) $ moduleDefinitions m) allModules - modify $ \s -> s - { tmsModules = modules - , tmsGlobals = globalDefs - } - cmdOut "load-done" + liftIO (parseTestFiles [ T.unpack path ]) >>= \case + Right ( modules, allModules ) -> do + let globalDefs = evalGlobalDefs $ concatMap (\m -> map (first ( moduleName m, )) $ moduleDefinitions m) allModules + modify $ \s -> s + { tmsModules = modules + , tmsGlobals = globalDefs + } + cmdOut "load-done" + + Left (ModuleNotFound moduleName) -> do + cmdOut $ "load-failed module-not-found" <> textModuleName moduleName + Left (FileNotFound notFoundPath) -> do + cmdOut $ "load-failed file-not-found " <> T.pack notFoundPath + Left (ImportModuleError bundle) -> do +#if MIN_VERSION_megaparsec(9,7,0) + mapM_ (cmdOut . T.pack) $ lines $ errorBundlePrettyWith showParseError bundle +#endif + cmdOut $ "load-failed parse-error" + where + showParseError _ SourcePos {..} _ = concat + [ "parse-error" + , " ", sourceName + , ":", show $ unPos sourceLine + , ":", show $ unPos sourceColumn + ] cmdRun :: Command cmdRun = do |