From 82cdfdac4028b39774ba2b7b4326f4246fff6820 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Wed, 19 Feb 2025 15:26:41 +0100 Subject: [PATCH] Import file parsing --- src/Ubc/Parse/Syntax/Import.hs | 118 ++++++++++++++++++++++++--------- 1 file changed, 87 insertions(+), 31 deletions(-) diff --git a/src/Ubc/Parse/Syntax/Import.hs b/src/Ubc/Parse/Syntax/Import.hs index 6812310..6dc5807 100644 --- a/src/Ubc/Parse/Syntax/Import.hs +++ b/src/Ubc/Parse/Syntax/Import.hs @@ -1,34 +1,40 @@ +{-# LANGUAGE LambdaCase #-} module Ubc.Parse.Syntax.Import -( -parse2) +( parse +, Import(..) +) where -import Control.Monad.Catch ( SomeException () ) +import Control.Arrow ((>>>)) + +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) import Data.Functor ((<&>)) + import Data.List.NonEmpty (NonEmpty) +import qualified Data.List as List +import qualified Data.Set as Set +import qualified Data.List.NonEmpty as NonEmpty + +import qualified System.Directory as IO 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 ) +import Path as Path ( Path, File, parseRelFile, Rel, parseRelDir, Dir, Abs, (), fromAbsFile, fromRelFile ) -import qualified Ubc.Parse.Syntax.Language as UbcLanguage -import qualified Data.List.NonEmpty as NonEmpty import Ubc.Parse.Syntax (Transformer) -import Control.Monad.Trans.Reader (ReaderT, asks) -import Ubc.Parse.Syntax.Config (Config) import qualified Ubc.Parse.Syntax.Config as Config -import qualified Data.Set as Set -import Control.Arrow ((>>>)) -import qualified Data.List as List -import Control.Monad.Trans (lift) -import qualified System.Directory as IO -import Control.Monad (filterM) +import qualified Ubc.Parse.Syntax.File as File +import qualified Ubc.Parse.Syntax.Language as UbcLanguage -data Import - = Failed SomeException - | Finished +data Import = Import + { file :: File.File + } importPath :: Monad m => ParsecT String u m (NonEmpty String) importPath = UbcLanguage.angles (many importChar `sepBy1` char '/') @@ -40,27 +46,77 @@ importChar = choice , notFollowedBy (oneOf ">/") >> anyChar ] -parse2 :: ParsecT String u Transformer Import -parse2 = do +parse :: ParsecT String u Transformer Import +parse = do UbcLanguage.reserved "import" fragments <- importPath - either (pure . Failed) (lift . resolvePaths . uncurry constructPaths) $ do - name <- Path.parseRelFile $ NonEmpty.last fragments - dirPath <- mapM Path.parseRelDir . NonEmpty.init $ fragments - pure (name, dirPath) + 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 -resolvePaths :: Transformer [Path Abs File] -> Transformer Import -resolvePaths paths = do - existingPaths <- paths >>= filterM (lift . IO.doesFileExist . Path.fromAbsFile) - pure Finished +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 -constructPaths :: Path Rel File -> [Path Rel Dir] -> Transformer ([Path Abs File]) -constructPaths file dirs = do +multipleFoundMessage :: Path Rel File -> [Path Abs File] -> String +multipleFoundMessage relFile foundFiles = "Could not identify imported file " <> Path.fromRelFile relFile <> "\n" + <> "Found multiple files in the search path:" + <> (unlines . List.map (Path.fromAbsFile >>> ('\t':)) $ foundFiles) + +notFoundMessage :: Path Rel File -> [Path Abs File] -> String +notFoundMessage relFile searchedLocations = "Could not locate import file path" <> Path.fromRelFile relFile <> "\n" + <> "Searched locations were:" + <> (unlines . List.map (('\t':) . Path.fromAbsFile) $ searchedLocations) + +parseFile :: MonadIO m => Path Abs File -> ParsecT String u m Import +parseFile path = do + let stringPath = Path.fromAbsFile path + contents <- liftIO . readFile $ stringPath + + -- save old state + oldInput <- Parsec.getInput + oldPosition <- Parsec.getPosition + + -- calculate new state + let newPosition = (flip Parsec.setSourceName) stringPath + >>> (flip Parsec.setSourceLine) 1 + >>> (flip Parsec.setSourceColumn) 1 + $ oldPosition + + -- prepare new state + Parsec.setInput contents + Parsec.setPosition newPosition + importedFile <- File.parse stringPath + + -- restore old state + Parsec.setInput oldInput + Parsec.setPosition oldPosition + + pure $ Import importedFile + +parseRelPath :: MonadThrow m => NonEmpty FilePath -> m (Path Rel File) +parseRelPath fragments = do + name <- Path.parseRelFile $ NonEmpty.last fragments + dirPath <- mapM Path.parseRelDir . NonEmpty.init $ fragments + pure $ constructRelative name dirPath + +constructRelative :: Path Rel t -> [Path Rel Dir] -> Path Rel t +constructRelative = foldr () + +filterInexistent :: [Path Abs File] -> IO [Path Abs File] +filterInexistent paths = filterM (IO.doesFileExist . Path.fromAbsFile) paths + +constructPaths :: Path Rel File -> Transformer [Path Abs File] +constructPaths suffix = do paths <- asks Config.includePaths Set.toList - >>> List.map (flip (foldl' ()) dirs) - >>> List.map ( file) + >>> List.map ( suffix) >>> pure $ paths