Evaluate asset path to absolute and check if it exists

2 files changed, 25 insertions, 7 deletions

diff --git a/src/Parser.hs b/src/Parser.hs
index 9160002..d90b796 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -106,9 +106,18 @@ parseAsset = label "asset definition" $ do
     osymbol ":"
     void eol
     ref <- L.indentGuard scn GT pos1
+
     wsymbol "path"
     osymbol ":"
-    assetPath <- AssetPath . TL.unpack <$> takeWhile1P Nothing (/= '\n')
+    off <- stateOffset <$> getParserState
+    path <- TL.unpack <$> takeWhile1P Nothing (/= '\n')
+    dir <- takeDirectory <$> gets testSourcePath
+    absPath <- liftIO (makeAbsolute $ dir </> path)
+    let assetPath = AssetPath absPath
+    liftIO (doesPathExist absPath) >>= \case
+        True -> return ()
+        False -> registerParseError $ FancyError off $ S.singleton $ ErrorCustom $ FileNotFound absPath
+
     void $ L.indentGuard scn LT ref
     let expr = SomeExpr $ Pure Asset {..}
     modify $ \s -> s { testVars = ( name, ( GlobalVarName (testCurrentModuleName s) name, someExprType expr )) : testVars s }
@@ -191,7 +200,8 @@ parseTestFile parsedModules moduleName path = do
         Just found -> return $ Right found
         Nothing -> do
             let initState = TestParserState
-                    { testVars = concat
+                    { testSourcePath = path
+                    , testVars = concat
                         [ map (\(( mname, name ), value ) -> ( name, ( GlobalVarName mname name, someVarValueType value ))) $ M.toList builtins
                         ]
                     , testContext = SomeExpr (Undefined "void" :: Expr Void)
@@ -206,7 +216,7 @@ parseTestFile parsedModules moduleName path = do
                 if isDoesNotExistError e then return Nothing else ioError e
             case mbContent of
                 Just content -> do
-                    runTestParser path content initState (parseTestModule absPath) >>= \case
+                    runTestParser content initState (parseTestModule absPath) >>= \case
                         Left bundle -> do
                             return $ Left $ ImportModuleError bundle
                         Right testModule -> do
diff --git a/src/Parser/Core.hs b/src/Parser/Core.hs
index d90f227..132dbc8 100644
--- a/src/Parser/Core.hs
+++ b/src/Parser/Core.hs
@@ -27,6 +27,7 @@ newtype TestParser a = TestParser (StateT TestParserState (ParsecT CustomTestErr
         , MonadState TestParserState
         , MonadPlus
         , MonadFail
+        , MonadIO
         , MonadParsec CustomTestError TestStream
         )
 
@@ -36,6 +37,7 @@ type TestParseError = ParseError TestStream CustomTestError
 
 data CustomTestError
     = ModuleNotFound ModuleName
+    | FileNotFound FilePath
     | ImportModuleError (ParseErrorBundle TestStream CustomTestError)
     deriving (Eq)
 
@@ -44,17 +46,22 @@ instance Ord CustomTestError where
     compare (ModuleNotFound _) _                  = LT
     compare _                  (ModuleNotFound _) = GT
 
+    compare (FileNotFound a) (FileNotFound b) = compare a b
+    compare (FileNotFound _) _                = LT
+    compare _                (FileNotFound _) = GT
+
     -- Ord instance is required to store errors in Set, but there shouldn't be
     -- two ImportModuleErrors at the same possition, so "dummy" comparison
     -- should be ok.
     compare (ImportModuleError _) (ImportModuleError _) = EQ
 
 instance ShowErrorComponent CustomTestError where
-    showErrorComponent (ModuleNotFound name) = "module `" <> T.unpack (textModuleName name) <> "' not found"
+    showErrorComponent (ModuleNotFound name) = "module ‘" <> T.unpack (textModuleName name) <> "’ not found"
+    showErrorComponent (FileNotFound path) = "file ‘" <> path <> "’ not found"
     showErrorComponent (ImportModuleError bundle) = "error parsing imported module:\n" <> errorBundlePretty bundle
 
-runTestParser :: String -> TestStream -> TestParserState -> TestParser a -> IO (Either (ParseErrorBundle TestStream CustomTestError) a)
-runTestParser path content initState (TestParser parser) = flip (flip runParserT path) content . flip evalStateT initState $ parser
+runTestParser :: TestStream -> TestParserState -> TestParser a -> IO (Either (ParseErrorBundle TestStream CustomTestError) a)
+runTestParser content initState (TestParser parser) = flip (flip runParserT (testSourcePath initState)) content . flip evalStateT initState $ parser
 
 data Toplevel
     = ToplevelTest Test
@@ -63,7 +70,8 @@ data Toplevel
     | ToplevelImport ( ModuleName, VarName )
 
 data TestParserState = TestParserState
-    { testVars :: [ ( VarName, ( FqVarName, SomeExprType )) ]
+    { testSourcePath :: FilePath
+    , testVars :: [ ( VarName, ( FqVarName, SomeExprType )) ]
     , testContext :: SomeExpr
     , testNextTypeVar :: Int
     , testTypeUnif :: Map TypeVar SomeExprType