github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-26 00:12:29 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #1701 from github/charliesome/remove-php-ns-fail

Browse Source 
Remove fail in Evaluatable NamespaceName instance
This commit is contained in:
Charlie Somerville 2018-04-04 17:44:54 +10:00 committed by GitHub
commit edf925e6e1
2 changed files with 22 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/Language/PHP/Assignment.hs
View File

@ -13,6 +13,7 @@ import Language.PHP.Grammar as Grammar
import Prologue
import qualified Assigning.Assignment as Assignment
import qualified Data.Abstract.FreeVariables as FV
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Syntax as Syntax
import qualified Data.Syntax.Comment as Comment
import qualified Data.Syntax.Declaration as Declaration
@ -130,19 +131,31 @@ type Syntax = '[
type Term = Term.Term (Union Syntax) (Record Location)
type Assignment = Assignment.Assignment [] Grammar Term
append :: a -> [a] -> [a]
append x xs = xs ++ [x]
bookend :: a -> [a] -> a -> [a]
bookend head list last = head : append last list
-- | Assignment from AST in PHP's grammar onto a program in PHP's syntax.
assignment :: Assignment
assignment = handleError $ makeTerm <$> symbol Program <*> children (Syntax.Program <$> ((\a b c -> a : b ++ [c]) <$> (text <|> emptyTerm) <*> manyTerm statement <*> (text <|> emptyTerm))) <|> parseError
assignment = handleError $ makeTerm <$> symbol Program <*> children (Syntax.Program <$> (bookend <$> (text <|> emptyTerm) <*> manyTerm statement <*> (text <|> emptyTerm))) <|> parseError
term :: Assignment -> Assignment
term term = contextualize (comment <|> textInterpolation) (postContextualize (comment <|> textInterpolation) term)
commentedTerm :: Assignment -> Assignment
commentedTerm term = contextualize (comment <|> textInterpolation) term <|> makeTerm1 <$> (Syntax.Context <$> some1 (comment <|> textInterpolation) <*> emptyTerm)
-- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
manyTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
manyTerm term = many (contextualize (comment <|> textInterpolation) term <|> makeTerm1 <$> (Syntax.Context <$> some1 (comment <|> textInterpolation) <*> emptyTerm))
manyTerm = many . commentedTerm
someTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
someTerm term = some (contextualize (comment <|> textInterpolation) term <|> makeTerm1 <$> (Syntax.Context <$> some1 (comment <|> textInterpolation) <*> emptyTerm))
someTerm = fmap NonEmpty.toList . someTerm'
someTerm' :: Assignment -> Assignment.Assignment [] Grammar (NonEmpty Term)
someTerm' = NonEmpty.some1 . commentedTerm
text :: Assignment
text = makeTerm <$> symbol Text <*> (Syntax.Text <$> source)
@ -459,7 +472,7 @@ namespaceNameAsPrefix :: Assignment
namespaceNameAsPrefix = symbol NamespaceNameAsPrefix *> children (term namespaceName <|> emptyTerm)
namespaceName :: Assignment
namespaceName = makeTerm <$> symbol NamespaceName <*> children (Syntax.NamespaceName <$> someTerm name)
namespaceName = makeTerm <$> symbol NamespaceName <*> children (Syntax.NamespaceName <$> someTerm' name)
updateExpression :: Assignment
updateExpression = makeTerm <$> symbol UpdateExpression <*> children (Syntax.Update <$> term expression)

12
src/Language/PHP/Syntax.hs
View File

@ -190,7 +190,7 @@ instance Evaluatable QualifiedName where
localEnv (mappend lhs) iden
newtype NamespaceName a = NamespaceName [a]
newtype NamespaceName a = NamespaceName (NonEmpty a)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 NamespaceName where liftEq = genericLiftEq
@ -198,13 +198,11 @@ instance Ord1 NamespaceName where liftCompare = genericLiftCompare
instance Show1 NamespaceName where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable NamespaceName where
eval (NamespaceName xs) = go xs
eval (NamespaceName xs) = foldl1 f $ fmap subtermValue xs
where
go [] = fail "nonempty NamespaceName not allowed"
go [x] = subtermValue x
go (x:xs) = do
env <- subtermValue x >>= scopedEnvironment
localEnv (mappend env) (go xs)
f ns nam = do
env <- ns >>= scopedEnvironment
localEnv (mappend env) nam
newtype ConstDeclaration a = ConstDeclaration [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)