program is runnable again, File doesn't backtrack out of import anymore

This commit is contained in:
VegOwOtenks 2025-02-21 14:43:35 +01:00
parent 6990c3f759
commit ac0e697622
5 changed files with 78 additions and 14 deletions

View file

@ -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 Text.Parsec as Parsec
import qualified Path as Path
import Ubc.Parse.Syntax.Config (Config(..))
import qualified Ubc.Parse.Syntax.File as File 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 :: IO ()
main = do main = do
text <- getContents text <- getContents
-- fixme: handle errors? -- fixme: handle errors?
print $ Parsec.parse (File.parse "<stdin>" <* Parsec.eof) "<stdin>" text parseConfig <- minimalConfig
result <- Reader.runReaderT (Parsec.runPT (File.parse <* Parsec.eof) () "<stdin>" text) parseConfig
print $ result
-- print $ Parsec.parse (File.parse <* Parsec.eof) "<stdin>" text

View file

@ -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.Function as Function
import qualified Ubc.Parse.Syntax.Statement as Statement import qualified Ubc.Parse.Syntax.Statement as Statement
import qualified Ubc.Parse.Syntax.Enumeration as Enumeration import qualified Ubc.Parse.Syntax.Enumeration as Enumeration
import qualified Text.Parsec as Parsec
data File = File data File = File
{ name :: String { name :: String
@ -44,8 +45,11 @@ data FileBody = FileBody
deriving (Semigroup, Monoid) via Generically FileBody deriving (Semigroup, Monoid) via Generically FileBody
-- dont use `deriving ... via FileBody` because that leads to a loop, somehow -- dont use `deriving ... via FileBody` because that leads to a loop, somehow
parse :: String -> ParsecT String u Transformer File parse :: ParsecT String u Transformer File
parse source = File source <$!> mconcat <$!> many fileMember parse = do
fileName <- Parsec.sourceName <$!> Parsec.getPosition
fileBody <- mconcat <$!> many fileMember
pure $ File fileName fileBody
fileMember :: ParsecT String u Transformer FileBody fileMember :: ParsecT String u Transformer FileBody
fileMember = choice fileMember = choice

View file

@ -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

View file

@ -54,7 +54,6 @@ parse :: ParsecT String u Transformer Import
parse = do parse = do
UbcLanguage.reserved "import" UbcLanguage.reserved "import"
fragments <- importPath fragments <- importPath
importAs <- option (NonEmpty.last fragments) importAlias
-- concatenate directory and file parts, also utf-decoding -- concatenate directory and file parts, also utf-decoding
relFile <- case parseRelPath fragments of relFile <- case parseRelPath fragments of
@ -66,12 +65,16 @@ parse = do
-- only existing files -- only existing files
existingFiles <- liftIO $ filterInexistent possiblePaths existingFiles <- liftIO $ filterInexistent possiblePaths
-- fail if there are multiple files -- fail or parse
case existingFiles of importedFile <- case existingFiles of
[] -> fail $ notFoundMessage relFile possiblePaths [] -> fail $ notFoundMessage relFile possiblePaths
[path] -> parseFile path importAs [path] -> parseFile path
fs@_ -> fail $ multipleFoundMessage relFile fs 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 :: Monad m => ParsecT String u m String
importAlias = UbcLanguage.reserved "as" importAlias = UbcLanguage.reserved "as"
*> UbcLanguage.identifier *> UbcLanguage.identifier
@ -82,12 +85,12 @@ multipleFoundMessage relFile foundFiles = "Could not identify imported file " <>
<> (unlines . List.map (Path.fromAbsFile >>> ('\t':)) $ foundFiles) <> (unlines . List.map (Path.fromAbsFile >>> ('\t':)) $ foundFiles)
notFoundMessage :: Path Rel File -> [Path Abs File] -> String notFoundMessage :: Path Rel File -> [Path Abs File] -> String
notFoundMessage relFile searchedLocations = "Could not locate import file path" <> Path.fromRelFile relFile <> "\n" notFoundMessage relFile searchedLocations = "Could not locate import file <" <> Path.fromRelFile relFile <> ">\n"
<> "Searched locations were:" <> "Searched locations were:\n"
<> (unlines . List.map (('\t':) . Path.fromAbsFile) $ searchedLocations) <> (unlines . List.map (('\t':) . Path.fromAbsFile) $ searchedLocations)
parseFile :: Path Abs File -> String -> ParsecT String u Transformer Import parseFile :: Path Abs File -> ParsecT String u Transformer File.File
parseFile path importAs = do parseFile path = do
let stringPath = Path.fromAbsFile path let stringPath = Path.fromAbsFile path
contents <- liftIO . readFile $ stringPath contents <- liftIO . readFile $ stringPath
@ -101,16 +104,21 @@ parseFile path importAs = do
>>> (flip Parsec.setSourceColumn) 1 >>> (flip Parsec.setSourceColumn) 1
$ oldPosition $ oldPosition
-- disable backtracking (consuming input)
Parsec.setInput "_" <* Parsec.char '_'
-- prepare new state -- prepare new state
Parsec.setInput contents Parsec.setInput contents
Parsec.setPosition newPosition Parsec.setPosition newPosition
importedFile <- File.parse stringPath
-- parse the file
importedFile <- File.parse <* Parsec.eof
-- restore old state -- restore old state
Parsec.setInput oldInput Parsec.setInput oldInput
Parsec.setPosition oldPosition Parsec.setPosition oldPosition
pure $ Import importedFile importAs pure importedFile
parseRelPath :: MonadThrow m => NonEmpty FilePath -> m (Path Rel File) parseRelPath :: MonadThrow m => NonEmpty FilePath -> m (Path Rel File)
parseRelPath fragments = do parseRelPath fragments = do

View file

@ -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