From ac0e697622ccf1699e08433a7c1c1b0f114ada47 Mon Sep 17 00:00:00 2001 From: VegOwOtenks Date: Fri, 21 Feb 2025 14:43:35 +0100 Subject: [PATCH] program is runnable again, File doesn't backtrack out of import anymore --- app/Main.hs | 26 ++++++++++++++++++++++++-- src/Ubc/Parse/Syntax/File.hs | 8 ++++++-- src/Ubc/Parse/Syntax/File.hs-boot | 15 +++++++++++++++ src/Ubc/Parse/Syntax/Import.hs | 28 ++++++++++++++++++---------- src/Ubc/Parse/Syntax/Import.hs-boot | 15 +++++++++++++++ 5 files changed, 78 insertions(+), 14 deletions(-) create mode 100644 src/Ubc/Parse/Syntax/File.hs-boot create mode 100644 src/Ubc/Parse/Syntax/Import.hs-boot diff --git a/app/Main.hs b/app/Main.hs index 0996528..0f4e265 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,10 +1,32 @@ -module Main (main) where +module Main +( main +) where + +import System.Directory as Directory +import qualified Control.Monad.Trans.Reader as Reader + +import qualified Data.Set as Set + import qualified Text.Parsec as Parsec + +import qualified Path as Path + +import Ubc.Parse.Syntax.Config (Config(..)) + import qualified Ubc.Parse.Syntax.File as File +minimalConfig :: IO Config +minimalConfig = do + workingDir <- Directory.getCurrentDirectory >>= Path.parseAbsDir + pure $ Config (Set.singleton workingDir) + main :: IO () main = do text <- getContents -- fixme: handle errors? - print $ Parsec.parse (File.parse "" <* Parsec.eof) "" text + parseConfig <- minimalConfig + + result <- Reader.runReaderT (Parsec.runPT (File.parse <* Parsec.eof) () "" text) parseConfig + print $ result +-- print $ Parsec.parse (File.parse <* Parsec.eof) "" text diff --git a/src/Ubc/Parse/Syntax/File.hs b/src/Ubc/Parse/Syntax/File.hs index 3552203..db7d116 100644 --- a/src/Ubc/Parse/Syntax/File.hs +++ b/src/Ubc/Parse/Syntax/File.hs @@ -26,6 +26,7 @@ import qualified Ubc.Parse.Syntax.Struct as Struct import qualified Ubc.Parse.Syntax.Function as Function import qualified Ubc.Parse.Syntax.Statement as Statement import qualified Ubc.Parse.Syntax.Enumeration as Enumeration +import qualified Text.Parsec as Parsec data File = File { name :: String @@ -44,8 +45,11 @@ data FileBody = FileBody deriving (Semigroup, Monoid) via Generically FileBody -- dont use `deriving ... via FileBody` because that leads to a loop, somehow -parse :: String -> ParsecT String u Transformer File -parse source = File source <$!> mconcat <$!> many fileMember +parse :: ParsecT String u Transformer File +parse = do + fileName <- Parsec.sourceName <$!> Parsec.getPosition + fileBody <- mconcat <$!> many fileMember + pure $ File fileName fileBody fileMember :: ParsecT String u Transformer FileBody fileMember = choice diff --git a/src/Ubc/Parse/Syntax/File.hs-boot b/src/Ubc/Parse/Syntax/File.hs-boot new file mode 100644 index 0000000..72b1dd6 --- /dev/null +++ b/src/Ubc/Parse/Syntax/File.hs-boot @@ -0,0 +1,15 @@ +module Ubc.Parse.Syntax.File +( File +, parse +) +where + +import Text.Parsec (ParsecT) + +import Ubc.Parse.Syntax (Transformer) + +data File +instance Show File + +parse :: ParsecT String u Transformer File + diff --git a/src/Ubc/Parse/Syntax/Import.hs b/src/Ubc/Parse/Syntax/Import.hs index 3f4ba86..d061b52 100644 --- a/src/Ubc/Parse/Syntax/Import.hs +++ b/src/Ubc/Parse/Syntax/Import.hs @@ -54,7 +54,6 @@ 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 @@ -66,12 +65,16 @@ parse = do -- only existing files existingFiles <- liftIO $ filterInexistent possiblePaths - -- fail if there are multiple files - case existingFiles of + -- fail or parse + importedFile <- case existingFiles of [] -> fail $ notFoundMessage relFile possiblePaths - [path] -> parseFile path importAs + [path] -> parseFile path fs@_ -> fail $ multipleFoundMessage relFile fs + importAs <- Parsec.parserTraced "alias" $ option (NonEmpty.last fragments) importAlias + + return $ Import importedFile importAs + importAlias :: Monad m => ParsecT String u m String importAlias = UbcLanguage.reserved "as" *> UbcLanguage.identifier @@ -82,12 +85,12 @@ multipleFoundMessage relFile foundFiles = "Could not identify imported file " <> <> (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:" +notFoundMessage relFile searchedLocations = "Could not locate import file <" <> Path.fromRelFile relFile <> ">\n" + <> "Searched locations were:\n" <> (unlines . List.map (('\t':) . Path.fromAbsFile) $ searchedLocations) -parseFile :: Path Abs File -> String -> ParsecT String u Transformer Import -parseFile path importAs = do +parseFile :: Path Abs File -> ParsecT String u Transformer File.File +parseFile path = do let stringPath = Path.fromAbsFile path contents <- liftIO . readFile $ stringPath @@ -101,16 +104,21 @@ parseFile path importAs = do >>> (flip Parsec.setSourceColumn) 1 $ oldPosition + -- disable backtracking (consuming input) + Parsec.setInput "_" <* Parsec.char '_' + -- prepare new state Parsec.setInput contents Parsec.setPosition newPosition - importedFile <- File.parse stringPath + + -- parse the file + importedFile <- File.parse <* Parsec.eof -- restore old state Parsec.setInput oldInput Parsec.setPosition oldPosition - pure $ Import importedFile importAs + pure importedFile parseRelPath :: MonadThrow m => NonEmpty FilePath -> m (Path Rel File) parseRelPath fragments = do diff --git a/src/Ubc/Parse/Syntax/Import.hs-boot b/src/Ubc/Parse/Syntax/Import.hs-boot new file mode 100644 index 0000000..2878d0a --- /dev/null +++ b/src/Ubc/Parse/Syntax/Import.hs-boot @@ -0,0 +1,15 @@ +module Ubc.Parse.Syntax.Import +( Import +, parse +) +where + +import Text.Parsec (ParsecT) + +import Ubc.Parse.Syntax (Transformer) + +data Import +instance Show Import + +parse :: ParsecT String u Transformer Import +