diff --git a/src/Ubc/Parse/Syntax/Import.hs b/src/Ubc/Parse/Syntax/Import.hs index b16ba6e..6dc5807 100644 --- a/src/Ubc/Parse/Syntax/Import.hs +++ b/src/Ubc/Parse/Syntax/Import.hs @@ -11,7 +11,7 @@ import Control.Monad (filterM) import Control.Monad.Catch ( MonadThrow, ) import Control.Monad.Trans (lift, MonadIO (liftIO)) import Control.Monad.Trans.Except () -import Control.Monad.Trans.Reader (asks, ReaderT) +import Control.Monad.Trans.Reader (asks) import Data.Functor ((<&>)) @@ -22,20 +22,18 @@ import qualified Data.List.NonEmpty as NonEmpty import qualified System.Directory as IO -import Text.Parsec (sepBy1, ParsecT, anyChar, many, char, choice, notFollowedBy, oneOf, option) +import Text.Parsec (sepBy1, ParsecT, anyChar, many, char, choice, notFollowedBy, oneOf) import qualified Text.Parsec as Parsec import Path as Path ( Path, File, parseRelFile, Rel, parseRelDir, Dir, Abs, (), fromAbsFile, fromRelFile ) import Ubc.Parse.Syntax (Transformer) -import Ubc.Parse.Syntax.Config (Config) import qualified Ubc.Parse.Syntax.Config as Config import qualified Ubc.Parse.Syntax.File as File import qualified Ubc.Parse.Syntax.Language as UbcLanguage data Import = Import { file :: File.File - , alias :: String } importPath :: Monad m => ParsecT String u m (NonEmpty String) @@ -52,27 +50,19 @@ parse :: ParsecT String u Transformer Import parse = do UbcLanguage.reserved "import" fragments <- importPath - importAs <- option (NonEmpty.last fragments) importAlias - -- concatenate directory and file parts, also utf-decoding - relFile <- case parseRelPath fragments of - Left err -> fail $ "Failed to decode path:\n" <> show err - Right relFile -> pure relFile + case parseRelPath fragments of + Left err -> fail $ "Failed to decode path:\n" <> show err + Right relFile -> do + possiblePaths <- lift $ constructPaths relFile + existingFiles <- liftIO $ filterInexistent possiblePaths + tryImport relFile possiblePaths existingFiles - -- appended to all search directories - possiblePaths <- lift $ constructPaths relFile - -- only existing files - existingFiles <- liftIO $ filterInexistent possiblePaths - - -- fail if there are multiple files - case existingFiles of - [] -> fail $ notFoundMessage relFile possiblePaths - [path] -> parseFile path importAs - fs@_ -> fail $ multipleFoundMessage relFile fs - -importAlias :: Monad m => ParsecT String u m String -importAlias = UbcLanguage.reserved "as" - *> UbcLanguage.identifier +tryImport :: Path Rel File -> [Path Abs File] -> [Path Abs File] -> ParsecT String u Transformer Import +tryImport targetFile searchedPaths = \case + [] -> fail $ notFoundMessage targetFile searchedPaths + [path] -> parseFile path + fs@_ -> fail $ multipleFoundMessage targetFile fs multipleFoundMessage :: Path Rel File -> [Path Abs File] -> String multipleFoundMessage relFile foundFiles = "Could not identify imported file " <> Path.fromRelFile relFile <> "\n" @@ -84,8 +74,8 @@ notFoundMessage relFile searchedLocations = "Could not locate import file path" <> "Searched locations were:" <> (unlines . List.map (('\t':) . Path.fromAbsFile) $ searchedLocations) -parseFile :: MonadIO m => Path Abs File -> String -> ParsecT String u m Import -parseFile path importAs = do +parseFile :: MonadIO m => Path Abs File -> ParsecT String u m Import +parseFile path = do let stringPath = Path.fromAbsFile path contents <- liftIO . readFile $ stringPath @@ -108,7 +98,7 @@ parseFile path importAs = do Parsec.setInput oldInput Parsec.setPosition oldPosition - pure $ Import importedFile importAs + pure $ Import importedFile parseRelPath :: MonadThrow m => NonEmpty FilePath -> m (Path Rel File) parseRelPath fragments = do @@ -122,7 +112,7 @@ constructRelative = foldr () filterInexistent :: [Path Abs File] -> IO [Path Abs File] filterInexistent paths = filterM (IO.doesFileExist . Path.fromAbsFile) paths -constructPaths :: Monad m => Path Rel t -> ReaderT Config m [Path Abs t] +constructPaths :: Path Rel File -> Transformer [Path Abs File] constructPaths suffix = do paths <- asks Config.includePaths Set.toList diff --git a/src/Ubc/Parse/Syntax/Language.hs b/src/Ubc/Parse/Syntax/Language.hs index b82eb97..c18f683 100644 --- a/src/Ubc/Parse/Syntax/Language.hs +++ b/src/Ubc/Parse/Syntax/Language.hs @@ -67,7 +67,6 @@ languageDef = LanguageDef { , "while" , "until" , "type" - , "import" ] , reservedOpNames = [ "+" , "-"