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