1
1
mirror of https://github.com/github/semantic.git synced 2024-12-20 21:31:48 +03:00

Bring back php includes and requires

This commit is contained in:
Timothy Clem 2018-03-30 15:48:05 -07:00
parent 38fc4b1dc0
commit e46ab3a596

View File

@ -1,12 +1,13 @@
{-# LANGUAGE DeriveAnyClass, ViewPatterns #-}
module Language.PHP.Syntax where
import Data.Abstract.Evaluatable
import Data.Abstract.Path
import Diffing.Algorithm
import Prelude hiding (fail)
import Prologue hiding (Text)
import Data.Abstract.Evaluatable
import qualified Data.Abstract.Module as M
import Data.Abstract.Path
import qualified Data.ByteString.Char8 as BC
import Diffing.Algorithm
import Prelude hiding (fail)
import Prologue hiding (Text)
newtype Text a = Text ByteString
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
@ -33,23 +34,28 @@ instance Evaluatable VariableName
-- file, the complete contents of the included file are treated as though it
-- were defined inside that function.
resolvePHPName :: MonadEvaluatable term value m => ByteString -> m M.ModuleName
resolvePHPName n = resolve [name] >>= maybeFail notFound
where name = toName n
notFound = "Unable to resolve: " <> name
toName = BC.unpack . dropRelativePrefix . stripQuotes
doInclude :: MonadEvaluatable term value m => Subterm t (m value) -> m value
doInclude path = do
name <- toQualifiedName <$> (subtermValue path >>= asString)
(importedEnv, v) <- isolate (load name)
doInclude pathTerm = do
name <- subtermValue pathTerm >>= asString
path <- resolvePHPName name
(importedEnv, v) <- isolate (load path)
modifyEnv (mappend importedEnv)
pure v
doIncludeOnce :: MonadEvaluatable term value m => Subterm t (m value) -> m value
doIncludeOnce path = do
name <- toQualifiedName <$> (subtermValue path >>= asString)
(importedEnv, v) <- isolate (require name)
doIncludeOnce pathTerm = do
name <- subtermValue pathTerm >>= asString
path <- resolvePHPName name
(importedEnv, v) <- isolate (require path)
modifyEnv (mappend importedEnv)
pure v
toQualifiedName :: ByteString -> Name
toQualifiedName = qualifiedName . splitOnPathSeparator . dropExtension . dropRelativePrefix . stripQuotes
newtype Require a = Require a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)