program is runnable again, File doesn't backtrack out of import anymore
This commit is contained in:
parent
6990c3f759
commit
ac0e697622
5 changed files with 78 additions and 14 deletions
26
app/Main.hs
26
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 "<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
|
||||
|
|
|
@ -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
|
||||
|
|
15
src/Ubc/Parse/Syntax/File.hs-boot
Normal file
15
src/Ubc/Parse/Syntax/File.hs-boot
Normal 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
|
||||
|
|
@ -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
|
||||
|
|
15
src/Ubc/Parse/Syntax/Import.hs-boot
Normal file
15
src/Ubc/Parse/Syntax/Import.hs-boot
Normal 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
|
||||
|
Loading…
Reference in a new issue