Prevent loop on recursive import

This commit is contained in:
Kirill Andreev 2020-07-03 20:01:17 +04:00
parent b35a28853b
commit 24cc24b0d7
No known key found for this signature in database
GPG Key ID: CF7DA79DE4785A47
2 changed files with 22 additions and 7 deletions

View File

@ -163,7 +163,6 @@ eventLoop funs chan = do
case Find.definitionOf pos tree of case Find.definitionOf pos tree of
Just defPos -> do Just defPos -> do
error "do later" error "do later"
Core.sendFunc funs $ RspDefinition $ _ $ J.SingleLoc $ J.Location uri $ rangeToLoc defPos
_ -> U.logs "unknown msg" _ -> U.logs "unknown msg"

View File

@ -74,6 +74,7 @@ import Data.Foldable
import Data.IORef import Data.IORef
import Data.Text (Text, unpack) import Data.Text (Text, unpack)
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Set as Set
import System.FilePath import System.FilePath
@ -95,7 +96,7 @@ type Parser =
(StateT (Product PList) (StateT (Product PList)
IO) IO)
type PList = [ParseForest, [Text], FilePath] type PList = [ParseForest, [Text], FilePath, Set.Set FilePath]
-- | Auto-accumulated information to be put into AST being build. -- | Auto-accumulated information to be put into AST being build.
type ASTInfo = Product [Range, [Text]] type ASTInfo = Product [Range, [Text]]
@ -109,14 +110,29 @@ runParser parser fin = do
let dir = takeDirectory fin let dir = takeDirectory fin
runWriterT parser `evalStateT` Cons pforest (Cons [] (Cons dir Nil)) runWriterT parser `evalStateT`
Cons pforest
(Cons []
(Cons dir
(Cons Set.empty
Nil)))
restart :: Parser a -> FilePath -> Parser a restart :: Stubbed a ASTInfo => Parser a -> FilePath -> Parser a
restart p fin = do restart p fin = do
dir <- get' @FilePath dir <- get' @FilePath
(a, errs) <- liftIO do runParser p (dir </> fin) let full = dir </> fin
tell errs set <- get' @(Set.Set FilePath)
return a
if Set.member full set
then do
fallback "recusive imports"
else do
(a, errs) <- liftIO do
flip runParser full do
put' (Set.insert full set)
p
tell errs
return a
get' :: forall x. Contains x PList => Parser x get' :: forall x. Contains x PList => Parser x
get' = gets getElem get' = gets getElem