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

Merge pull request #1744 from github/typescript-graphs

Browse Source 
Fixes for better import graphing
This commit is contained in:
Patrick Thomson 2018-04-18 14:28:09 -04:00 committed by GitHub
commit f40c871a10
59 changed files with 782 additions and 565 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.gitignore vendored
View File

@ -17,7 +17,8 @@ bin/
*.prof
*.pyc
test.rb
/test.*
/*.html
.bundle/
.licenses/vendor/gems

2
semantic.cabal
View File

@ -53,6 +53,7 @@ library
, Data.Abstract.Evaluatable
, Data.Abstract.Exports
, Data.Abstract.FreeVariables
, Data.Abstract.Declarations
, Data.Abstract.Heap
, Data.Abstract.Live
, Data.Abstract.Located
@ -238,6 +239,7 @@ test-suite test
, Analysis.Ruby.Spec
, Analysis.TypeScript.Spec
, Data.Diff.Spec
, Data.Abstract.Path.Spec
, Data.Functor.Classes.Generic.Spec
, Data.Functor.Listable
, Data.Mergeable.Spec

3
src/Analysis/Abstract/BadModuleResolutions.hs
View File

@ -27,6 +27,7 @@ instance ( Effectful m
analyzeTerm eval term = resumeException @(ResolutionError value) (liftAnalyze analyzeTerm eval term) (
\yield error -> case error of
(RubyError nameToResolve) -> yield nameToResolve)
(RubyError nameToResolve) -> yield nameToResolve
(TypeScriptError nameToResolve) -> yield nameToResolve)
analyzeModule = liftAnalyze analyzeModule

17
src/Analysis/Abstract/BadValues.hs
View File

@ -29,14 +29,19 @@ instance ( Effectful m
analyzeTerm eval term = resumeException @(ValueError location value) (liftAnalyze analyzeTerm eval term) (
\yield error -> case error of
(ScopedEnvironmentError _) -> do
ScopedEnvironmentError{} -> do
env <- getEnv
yield (Env.push env)
(CallError val) -> yield val
(StringError val) -> yield (pack $ show val)
BoolError{} -> yield True
Numeric2Error{} -> unit >>= yield
NamespaceError{} -> getEnv >>= yield
CallError val -> yield val
StringError val -> yield (pack $ show val)
BoolError{} -> yield True
NumericError{} -> unit >>= yield
Numeric2Error{} -> unit >>= yield
ComparisonError{} -> unit >>= yield
NamespaceError{} -> getEnv >>= yield
BitwiseError{} -> unit >>= yield
Bitwise2Error{} -> unit >>= yield
KeyValueError{} -> unit >>= \x -> yield (x, x)
)
analyzeModule = liftAnalyze analyzeModule

9
src/Analysis/Abstract/BadVariables.hs
View File

@ -28,7 +28,12 @@ instance ( Effectful m
analyzeTerm eval term = resumeException @(EvalError value) (liftAnalyze analyzeTerm eval term) (
\yield err -> case err of
(FreeVariableError name) -> raise (modify' (name :)) >> unit >>= yield
(FreeVariablesError names) -> raise (modify' (names <>)) >> yield (last names) )
DefaultExportError{} -> yield ()
ExportError{} -> yield ()
IntegerFormatError{} -> yield 0
FloatFormatError{} -> yield 0
RationalFormatError{} -> yield 0
FreeVariableError name -> raise (modify' (name :)) >> unit >>= yield
FreeVariablesError names -> raise (modify' (names <>)) >> yield (fromMaybeLast "unknown" names))
analyzeModule = liftAnalyze analyzeModule

12
src/Analysis/Abstract/Evaluating.hs
View File

@ -49,6 +49,7 @@ data EvaluatingState location term value = EvaluatingState
{ environment :: Environment location value
, heap :: Heap location value
, modules :: ModuleTable (Environment location value, value)
, loadStack :: LoadStack
, exports :: Exports location value
, jumps :: IntMap.IntMap term
, origin :: SomeOrigin term
@ -58,8 +59,11 @@ deriving instance (Eq (Cell location value), Eq location, Eq term, Eq value, Eq
deriving instance (Ord (Cell location value), Ord location, Ord term, Ord value, Ord (Base term ())) => Ord (EvaluatingState location term value)
deriving instance (Show (Cell location value), Show location, Show term, Show value, Show (Base term ())) => Show (EvaluatingState location term value)
instance (Ord location, Semigroup (Cell location value)) => Semigroup (EvaluatingState location term value) where
EvaluatingState e1 h1 m1 l1 x1 j1 o1 <> EvaluatingState e2 h2 m2 l2 x2 j2 o2 = EvaluatingState (e1 <> e2) (h1 <> h2) (m1 <> m2) (l1 <> l2) (x1 <> x2) (j1 <> j2) (o1 <> o2)
instance (Ord location, Semigroup (Cell location value)) => Empty (EvaluatingState location term value) where
empty = EvaluatingState mempty mempty mempty mempty mempty mempty
empty = EvaluatingState mempty mempty mempty mempty mempty mempty mempty
_environment :: Lens' (EvaluatingState location term value) (Environment location value)
_environment = lens environment (\ s e -> s {environment = e})
@ -70,6 +74,9 @@ _heap = lens heap (\ s h -> s {heap = h})
_modules :: Lens' (EvaluatingState location term value) (ModuleTable (Environment location value, value))
_modules = lens modules (\ s m -> s {modules = m})
_loadStack :: Lens' (EvaluatingState location term value) LoadStack
_loadStack = lens loadStack (\ s l -> s {loadStack = l})
_exports :: Lens' (EvaluatingState location term value) (Exports location value)
_exports = lens exports (\ s e -> s {exports = e})
@ -140,6 +147,9 @@ instance Members '[ Reader (ModuleTable [Module term])
askModuleTable = raise ask
localModuleTable f a = raise (local f (lower a))
getLoadStack = view _loadStack
putLoadStack = (_loadStack .=)
currentModule = do
o <- raise ask
maybeFail "unable to get currentModule" $ withSomeOrigin (originModule @term) o

12
src/Control/Abstract/Evaluator.hs
View File

@ -13,6 +13,7 @@ module Control.Abstract.Evaluator
, assign
, MonadModuleTable(..)
, modifyModuleTable
, modifyLoadStack
, MonadControl(..)
, MonadThrow(..)
) where
@ -147,6 +148,11 @@ class Monad m => MonadModuleTable location term value m | m -> location, m -> te
-- | Run an action with a locally-modified table of unevaluated modules.
localModuleTable :: (ModuleTable [Module term] -> ModuleTable [Module term]) -> m a -> m a
-- | Retrieve the module load stack
getLoadStack :: m LoadStack
-- | Set the module load stack
putLoadStack :: LoadStack -> m ()
-- | Get the currently evaluating 'ModuleInfo'.
currentModule :: m ModuleInfo
@ -156,6 +162,12 @@ modifyModuleTable f = do
table <- getModuleTable
putModuleTable $! f table
-- | Update the module load stack.
modifyLoadStack :: MonadModuleTable location term value m => (LoadStack -> LoadStack) -> m ()
modifyLoadStack f = do
stack <- getLoadStack
putLoadStack $! f stack
-- | A 'Monad' abstracting jumps in imperative control.
class Monad m => MonadControl term m where

13
src/Control/Abstract/Value.hs
View File

@ -190,11 +190,16 @@ class ValueRoots location value where
-- The type of exceptions that can be thrown when constructing values in `MonadValue`.
data ValueError location value resume where
StringError :: value -> ValueError location value ByteString
BoolError :: value -> ValueError location value Bool
NamespaceError :: Prelude.String -> ValueError location value (Environment location value)
ScopedEnvironmentError :: Prelude.String -> ValueError location value (Environment location value)
CallError :: value -> ValueError location value value
BoolError :: value -> ValueError location value Bool
Numeric2Error :: value -> value -> ValueError location value value
NumericError :: value -> ValueError location value value
Numeric2Error :: value -> value -> ValueError location value value
ComparisonError :: value -> value -> ValueError location value value
BitwiseError :: value -> ValueError location value value
Bitwise2Error :: value -> value -> ValueError location value value
KeyValueError :: value -> ValueError location value (value, value)
instance Eq value => Eq1 (ValueError location value) where
liftEq _ (StringError a) (StringError b) = a == b
@ -203,6 +208,10 @@ instance Eq value => Eq1 (ValueError location value) where
liftEq _ (CallError a) (CallError b) = a == b
liftEq _ (BoolError a) (BoolError c) = a == c
liftEq _ (Numeric2Error a b) (Numeric2Error c d) = (a == c) && (b == d)
liftEq _ (ComparisonError a b) (ComparisonError c d) = (a == c) && (b == d)
liftEq _ (Bitwise2Error a b) (Bitwise2Error c d) = (a == c) && (b == d)
liftEq _ (BitwiseError a) (BitwiseError b) = a == b
liftEq _ (KeyValueError a) (KeyValueError b) = a == b
liftEq _ _ _ = False
deriving instance (Show value) => Show (ValueError location value resume)

26
src/Data/Abstract/Declarations.hs Normal file
View File

@ -0,0 +1,26 @@
{-# LANGUAGE UndecidableInstances #-}
module Data.Abstract.Declarations where
import Data.Abstract.FreeVariables
import Data.Term
import Prologue
class Declarations syntax where
declaredName :: syntax -> Maybe Name
declaredName = const Nothing
class Declarations1 syntax where
-- | Lift a function mapping each element to its set of free variables through a containing structure, collecting the results into a single set.
liftDeclaredName :: (a -> [Name]) -> syntax a -> Maybe Name
liftDeclaredName _ _ = Nothing
instance Declarations t => Declarations (Subterm t a) where
declaredName = declaredName . subterm
instance (FreeVariables1 syntax, Declarations1 syntax, Functor syntax) => Declarations (Term syntax ann) where
declaredName = liftDeclaredName freeVariables . termOut
instance (Apply Declarations1 fs) => Declarations1 (Union fs) where
liftDeclaredName f = apply (Proxy :: Proxy Declarations1) (liftDeclaredName f)
instance Declarations1 []

47
src/Data/Abstract/Evaluatable.hs
View File

@ -17,6 +17,7 @@ module Data.Abstract.Evaluatable
, throwEvalError
, throwValueError
, resolve
, traceResolve
, listModulesInDir
, require
, load
@ -26,6 +27,7 @@ module Data.Abstract.Evaluatable
import Control.Abstract.Addressable as X
import Control.Abstract.Analysis as X
import Data.Abstract.Address
import Data.Abstract.Declarations as X
import Data.Abstract.Environment as X
import qualified Data.Abstract.Exports as Exports
import Data.Abstract.FreeVariables as X
@ -33,6 +35,7 @@ import Data.Abstract.Module
import Data.Abstract.ModuleTable as ModuleTable
import Data.Abstract.Origin (SomeOrigin, packageOrigin)
import Data.Abstract.Package as Package
import Data.Scientific (Scientific)
import Data.Semigroup.App
import Data.Semigroup.Foldable
import Data.Semigroup.Reducer hiding (unit)
@ -42,6 +45,7 @@ import Prologue
type MonadEvaluatable location term value m =
( Evaluatable (Base term)
, FreeVariables term
, Declarations term
, MonadAddressable location m
, MonadAnalysis location term value m
, MonadThrow (Unspecialized value) m
@ -58,13 +62,16 @@ type MonadEvaluatable location term value m =
-- | An error thrown when we can't resolve a module from a qualified name.
data ResolutionError value resume where
RubyError :: String -> ResolutionError value ModulePath
TypeScriptError :: String -> ResolutionError value ModulePath
deriving instance Eq (ResolutionError a b)
deriving instance Show (ResolutionError a b)
instance Show1 (ResolutionError value) where
liftShowsPrec _ _ = showsPrec
instance Eq1 (ResolutionError value) where
liftEq _ (RubyError a) (RubyError b) = a == b
liftEq _ (RubyError a) (RubyError b) = a == b
liftEq _ (TypeScriptError a) (TypeScriptError b) = a == b
liftEq _ _ _ = False
-- | An error thrown when loading a module from the list of provided modules. Indicates we weren't able to find a module with the given name.
data LoadError term value resume where
@ -82,6 +89,13 @@ data EvalError value resume where
-- Indicates we weren't able to dereference a name from the evaluated environment.
FreeVariableError :: Name -> EvalError value value
FreeVariablesError :: [Name] -> EvalError value Name
-- Indicates that our evaluator wasn't able to make sense of these literals.
IntegerFormatError :: ByteString -> EvalError value Integer
FloatFormatError :: ByteString -> EvalError value Scientific
RationalFormatError :: ByteString -> EvalError value Rational
DefaultExportError :: EvalError value ()
ExportError :: ModulePath -> Name -> EvalError value ()
-- | Look up and dereference the given 'Name', throwing an exception for free variables.
variable :: MonadEvaluatable location term value m => Name -> m value
@ -92,9 +106,14 @@ deriving instance Show (EvalError a b)
instance Show1 (EvalError value) where
liftShowsPrec _ _ = showsPrec
instance Eq1 (EvalError term) where
liftEq _ (FreeVariableError a) (FreeVariableError b) = a == b
liftEq _ (FreeVariablesError a) (FreeVariablesError b) = a == b
liftEq _ _ _ = False
liftEq _ (FreeVariableError a) (FreeVariableError b) = a == b
liftEq _ (FreeVariablesError a) (FreeVariablesError b) = a == b
liftEq _ DefaultExportError DefaultExportError = True
liftEq _ (ExportError a b) (ExportError c d) = (a == c) && (b == d)
liftEq _ (IntegerFormatError a) (IntegerFormatError b) = a == b
liftEq _ (FloatFormatError a) (FloatFormatError b) = a == b
liftEq _ (RationalFormatError a) (RationalFormatError b) = a == b
liftEq _ _ _ = False
throwValueError :: MonadEvaluatable location term value m => ValueError location value resume -> m resume
@ -152,6 +171,9 @@ resolve names = do
tbl <- askModuleTable
pure $ find (`ModuleTable.member` tbl) names
traceResolve :: (Show a, Show b) => a -> b -> c -> c
traceResolve name path = trace ("resolved " <> show name <> " -> " <> show path)
listModulesInDir :: MonadEvaluatable location term value m
=> FilePath
-> m [ModulePath]
@ -183,10 +205,19 @@ load name = askModuleTable >>= maybeM notFound . ModuleTable.lookup name >>= eva
pure (env <> env', v')
evalAndCache' x = do
v <- evaluateModule x
env <- filterEnv <$> getExports <*> getEnv
modifyModuleTable (ModuleTable.insert name (env, v))
pure (env, v)
let mPath = modulePath (moduleInfo x)
LoadStack{..} <- getLoadStack
if mPath `elem` unLoadStack
then do -- Circular load, don't keep evaluating.
v <- trace ("load (skip evaluating, circular load): " <> show mPath) unit
pure (mempty, v)
else do
modifyLoadStack (loadStackPush mPath)
v <- trace ("load (evaluating): " <> show mPath) $ evaluateModule x
modifyLoadStack loadStackPop
env <- filterEnv <$> getExports <*> getEnv
modifyModuleTable (ModuleTable.insert name (env, v))
pure (env, v)
-- TODO: If the set of exports is empty because no exports have been
-- defined, do we export all terms, or no terms? This behavior varies across

3
src/Data/Abstract/FreeVariables.hs
View File

@ -45,6 +45,9 @@ freeVariable term = case freeVariables term of
[n] -> Right n
xs -> Left xs
instance (FreeVariables t) => FreeVariables (Subterm t a) where
freeVariables = freeVariables . subterm
instance (FreeVariables1 syntax, Functor syntax) => FreeVariables (Term syntax ann) where
freeVariables = cata (liftFreeVariables id)

8
src/Data/Abstract/Module.hs
View File

@ -11,7 +11,7 @@ import System.FilePath.Posix
type ModulePath = FilePath
data ModuleInfo = ModuleInfo { modulePath :: FilePath, moduleRoot :: FilePath }
newtype ModuleInfo = ModuleInfo { modulePath :: FilePath }
deriving (Eq, Ord, Show)
data Module term = Module { moduleInfo :: ModuleInfo, moduleBody :: term }
@ -27,7 +27,5 @@ moduleForBlob :: Maybe FilePath -- ^ The root directory relative to which the mo
-> term -- ^ The @term@ representing the body of the module.
-> Module term -- ^ A 'Module' named appropriate for the 'Blob', holding the @term@, and constructed relative to the root 'FilePath', if any.
moduleForBlob rootDir Blob{..} = Module info
where
root = fromMaybe (takeDirectory blobPath) rootDir
modulePath = maybe takeFileName makeRelative rootDir
info = ModuleInfo (modulePath blobPath) root
where root = fromMaybe (takeDirectory blobPath) rootDir
info = ModuleInfo (makeRelative root blobPath)

20
src/Data/Abstract/ModuleTable.hs
View File

@ -7,8 +7,12 @@ module Data.Abstract.ModuleTable
, member
, modulePathsInDir
, insert
, keys
, fromModules
, toPairs
, LoadStack (..)
, loadStackPush
, loadStackPop
) where
import Data.Abstract.Module
@ -37,11 +41,25 @@ member k = Map.member k . unModuleTable
insert :: ModulePath -> a -> ModuleTable a -> ModuleTable a
insert k v = ModuleTable . Map.insert k v . unModuleTable
keys :: ModuleTable a -> [ModulePath]
keys = Map.keys . unModuleTable
-- | Construct a 'ModuleTable' from a list of 'Module's.
fromModules :: [Module term] -> ModuleTable [Module term]
fromModules modules = let x = ModuleTable (Map.fromListWith (<>) (map toEntry modules)) in traceShow x x
fromModules modules = ModuleTable (Map.fromListWith (<>) (map toEntry modules))
where toEntry m = (modulePath (moduleInfo m), [m])
toPairs :: ModuleTable a -> [(ModulePath, a)]
toPairs = Map.toList . unModuleTable
-- | Stack of module paths used to help break circular loads/imports.
newtype LoadStack = LoadStack { unLoadStack :: [ModulePath] }
deriving (Eq, Ord, Show, Monoid, Semigroup)
loadStackPush :: ModulePath -> LoadStack -> LoadStack
loadStackPush x LoadStack{..} = LoadStack (x : unLoadStack)
loadStackPop :: LoadStack -> LoadStack
loadStackPop (LoadStack []) = LoadStack []
loadStackPop (LoadStack (_:xs)) = LoadStack xs

21
src/Data/Abstract/Path.hs
View File

@ -3,17 +3,24 @@ module Data.Abstract.Path where
import Prologue
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString as B
import System.FilePath.Posix
splitOnPathSeparator :: ByteString -> [ByteString]
splitOnPathSeparator = BC.split '/'
-- | Join two paths a and b. Handles walking up relative directories in b. e.g.
--
-- joinPaths "a/b" "../c" == "a/c"
-- joinPaths "a/b" "./c" == "a/b/c"
--
-- Walking beyond the beginning of a just stops when you get to the root of a.
joinPaths :: FilePath -> FilePath -> FilePath
joinPaths a b = let bs = splitPath (normalise b)
n = length (filter (== "../") bs)
in normalise $ walkup n a </> joinPath (drop n bs)
where
walkup 0 str = str
walkup n str = walkup (pred n) (takeDirectory str)
stripQuotes :: ByteString -> ByteString
stripQuotes = B.filter (`B.notElem` "\'\"")
dropRelativePrefix :: ByteString -> ByteString
dropRelativePrefix = BC.dropWhile (== '/') . BC.dropWhile (== '.')
dropExtension :: ByteString -> ByteString
dropExtension path = case BC.split '.' path of
[] -> path
xs -> BC.intercalate "." (Prelude.init xs)

22
src/Data/Abstract/Value.hs
View File

@ -9,7 +9,7 @@ import qualified Data.Abstract.Number as Number
import Data.Scientific (Scientific)
import qualified Data.Set as Set
import Prologue hiding (TypeError)
import Prelude hiding (Float, Integer, String, Rational, fail)
import Prelude hiding (Float, Integer, String, Rational)
import qualified Prelude
type ValueConstructors location
@ -206,9 +206,9 @@ instance forall location term m. (Monad m, MonadEvaluatable location term (Value
null = pure . injValue $ Null
asPair k
| Just (KVPair k v) <- prjValue k = pure (k, v)
| otherwise = fail ("expected key-value pair, got " <> show k)
asPair val
| Just (KVPair k v) <- prjValue val = pure (k, v)
| otherwise = throwException @(ValueError location (Value location)) $ KeyValueError val
hash = pure . injValue . Hash . fmap (injValue . uncurry KVPair)
@ -245,9 +245,9 @@ instance forall location term m. (Monad m, MonadEvaluatable location term (Value
liftNumeric f arg
| Just (Integer (Number.Integer i)) <- prjValue arg = integer $ f i
| Just (Float (Number.Decimal d)) <- prjValue arg = float $ f d
| Just (Rational (Number.Ratio r)) <- prjValue arg = rational $ f r
| otherwise = fail ("Invalid operand to liftNumeric: " <> show arg)
| Just (Float (Number.Decimal d)) <- prjValue arg = float $ f d
| Just (Rational (Number.Ratio r)) <- prjValue arg = rational $ f r
| otherwise = throwValueError (NumericError arg)
liftNumeric2 f left right
| Just (Integer i, Integer j) <- prjPair pair = f i j & specialize
@ -276,7 +276,7 @@ instance forall location term m. (Monad m, MonadEvaluatable location term (Value
| Just (String i, String j) <- prjPair pair = go i j
| Just (Boolean i, Boolean j) <- prjPair pair = go i j
| Just (Unit, Unit) <- prjPair pair = boolean True
| otherwise = fail ("Type error: invalid arguments to liftComparison: " <> show pair)
| otherwise = throwValueError (ComparisonError left right)
where
-- Explicit type signature is necessary here because we're passing all sorts of things
-- to these comparison functions.
@ -294,11 +294,11 @@ instance forall location term m. (Monad m, MonadEvaluatable location term (Value
liftBitwise operator target
| Just (Integer (Number.Integer i)) <- prjValue target = integer $ operator i
| otherwise = fail ("Type error: invalid unary bitwise operation on " <> show target)
| otherwise = throwValueError (BitwiseError target)
liftBitwise2 operator left right
| Just (Integer (Number.Integer i), Integer (Number.Integer j)) <- prjPair pair = integer $ operator i j
| otherwise = fail ("Type error: invalid binary bitwise operation on " <> show pair)
| otherwise = throwValueError (Bitwise2Error left right)
where pair = (left, right)
lambda names (Subterm body _) = do
@ -314,6 +314,6 @@ instance forall location term m. (Monad m, MonadEvaluatable location term (Value
assign a v
Env.insert name a <$> rest) (pure env) (zip names params)
localEnv (mappend bindings) (goto label >>= evaluateTerm)
Nothing -> throwException @(ValueError location (Value location)) (CallError op)
Nothing -> throwValueError (CallError op)
loop = fix

14
src/Data/Syntax.hs
View File

@ -111,9 +111,11 @@ instance Evaluatable Identifier where
instance FreeVariables1 Identifier where
liftFreeVariables _ (Identifier x) = pure x
instance Declarations1 Identifier where
liftDeclaredName _ (Identifier x) = pure x
newtype Program a = Program [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Program where liftEq = genericLiftEq
instance Ord1 Program where liftCompare = genericLiftCompare
@ -124,7 +126,7 @@ instance Evaluatable Program where
-- | An accessibility modifier, e.g. private, public, protected, etc.
newtype AccessibilityModifier a = AccessibilityModifier ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 AccessibilityModifier where liftEq = genericLiftEq
instance Ord1 AccessibilityModifier where liftCompare = genericLiftCompare
@ -137,7 +139,7 @@ instance Evaluatable AccessibilityModifier
--
-- This can be used to represent an implicit no-op, e.g. the alternative in an 'if' statement without an 'else'.
data Empty a = Empty
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Empty where liftEq _ _ _ = True
instance Ord1 Empty where liftCompare _ _ _ = EQ
@ -149,7 +151,7 @@ instance Evaluatable Empty where
-- | A parenthesized expression or statement. All the languages we target support this concept.
newtype Paren a = Paren a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Paren where liftEq = genericLiftEq
instance Ord1 Paren where liftCompare = genericLiftCompare
@ -160,7 +162,7 @@ instance Evaluatable Paren where
-- | Syntax representing a parsing or assignment error.
data Error a = Error { errorCallStack :: ErrorStack, errorExpected :: [String], errorActual :: Maybe String, errorChildren :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Error where liftEq = genericLiftEq
instance Ord1 Error where liftCompare = genericLiftCompare
@ -191,7 +193,7 @@ instance Ord ErrorStack where
data Context a = Context { contextTerms :: NonEmpty a, contextSubject :: a }
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Diffable Context where
subalgorithmFor blur focus (Context n s) = Context <$> traverse blur n <*> focus s

2
src/Data/Syntax/Comment.hs
View File

@ -7,7 +7,7 @@ import Diffing.Algorithm
-- | An unnested comment (line or block).
newtype Comment a = Comment { commentContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Comment where liftEq = genericLiftEq
instance Ord1 Comment where liftCompare = genericLiftCompare

58
src/Data/Syntax/Declaration.hs
View File

@ -7,7 +7,7 @@ import Diffing.Algorithm
import Prologue
data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a }
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Diffable Function where
equivalentBySubterm = Just . functionName
@ -27,9 +27,12 @@ instance Evaluatable Function where
pure v
where paramNames = foldMap (freeVariables . subterm)
instance Declarations a => Declarations (Function a) where
declaredName Function{..} = declaredName functionName
data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a }
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Diffable Method where
equivalentBySubterm = Just . methodName
@ -51,7 +54,7 @@ instance Evaluatable Method where
-- | A method signature in TypeScript or a method spec in Go.
data MethodSignature a = MethodSignature { _methodSignatureContext :: ![a], _methodSignatureName :: !a, _methodSignatureParameters :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 MethodSignature where liftEq = genericLiftEq
instance Ord1 MethodSignature where liftCompare = genericLiftCompare
@ -62,7 +65,7 @@ instance Evaluatable MethodSignature
newtype RequiredParameter a = RequiredParameter { requiredParameter :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 RequiredParameter where liftEq = genericLiftEq
instance Ord1 RequiredParameter where liftCompare = genericLiftCompare
@ -73,7 +76,7 @@ instance Evaluatable RequiredParameter
newtype OptionalParameter a = OptionalParameter { optionalParameter :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 OptionalParameter where liftEq = genericLiftEq
instance Ord1 OptionalParameter where liftCompare = genericLiftCompare
@ -88,7 +91,7 @@ instance Evaluatable OptionalParameter
-- TODO: It would be really nice to have a more meaningful type contained in here than [a]
-- | A declaration of possibly many variables such as var foo = 5, bar = 6 in JavaScript.
newtype VariableDeclaration a = VariableDeclaration { variableDeclarations :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 VariableDeclaration where liftEq = genericLiftEq
instance Ord1 VariableDeclaration where liftCompare = genericLiftCompare
@ -98,9 +101,15 @@ instance Evaluatable VariableDeclaration where
eval (VariableDeclaration []) = unit
eval (VariableDeclaration decs) = multiple =<< traverse subtermValue decs
instance Declarations a => Declarations (VariableDeclaration a) where
declaredName (VariableDeclaration vars) = case vars of
[var] -> declaredName var
_ -> Nothing
-- | A TypeScript/Java style interface declaration to implement.
data InterfaceDeclaration a = InterfaceDeclaration { interfaceDeclarationContext :: ![a], interfaceDeclarationIdentifier :: !a, interfaceDeclarationBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 InterfaceDeclaration where liftEq = genericLiftEq
instance Ord1 InterfaceDeclaration where liftCompare = genericLiftCompare
@ -109,10 +118,13 @@ instance Show1 InterfaceDeclaration where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for InterfaceDeclaration
instance Evaluatable InterfaceDeclaration
instance Declarations a => Declarations (InterfaceDeclaration a) where
declaredName InterfaceDeclaration{..} = declaredName interfaceDeclarationIdentifier
-- | A public field definition such as a field definition in a JavaScript class.
data PublicFieldDefinition a = PublicFieldDefinition { publicFieldContext :: ![a], publicFieldPropertyName :: !a, publicFieldValue :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 PublicFieldDefinition where liftEq = genericLiftEq
instance Ord1 PublicFieldDefinition where liftCompare = genericLiftCompare
@ -123,7 +135,7 @@ instance Evaluatable PublicFieldDefinition
data Variable a = Variable { variableName :: !a, variableType :: !a, variableValue :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Variable where liftEq = genericLiftEq
instance Ord1 Variable where liftCompare = genericLiftCompare
@ -133,7 +145,10 @@ instance Show1 Variable where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Variable
data Class a = Class { classContext :: ![a], classIdentifier :: !a, classSuperclasses :: ![a], classBody :: !a }
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Declarations a => Declarations (Class a) where
declaredName (Class _ name _ _) = declaredName name
instance Diffable Class where
equivalentBySubterm = Just . classIdentifier
@ -154,7 +169,7 @@ instance Evaluatable Class where
-- | A decorator in Python
data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Decorator where liftEq = genericLiftEq
instance Ord1 Decorator where liftCompare = genericLiftCompare
@ -168,7 +183,7 @@ instance Evaluatable Decorator
-- | An ADT, i.e. a disjoint sum of products, like 'data' in Haskell, or 'enum' in Rust or Swift.
data Datatype a = Datatype { datatypeName :: !a, datatypeConstructors :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Data.Syntax.Declaration.Datatype where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Declaration.Datatype where liftCompare = genericLiftCompare
@ -180,7 +195,7 @@ instance Evaluatable Data.Syntax.Declaration.Datatype
-- | A single constructor in a datatype, or equally a 'struct' in C, Rust, or Swift.
data Constructor a = Constructor { constructorName :: !a, constructorFields :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Data.Syntax.Declaration.Constructor where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Declaration.Constructor where liftCompare = genericLiftCompare
@ -192,7 +207,7 @@ instance Evaluatable Data.Syntax.Declaration.Constructor
-- | Comprehension (e.g. ((a for b in c if a()) in Python)
data Comprehension a = Comprehension { comprehensionValue :: !a, comprehensionBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Comprehension where liftEq = genericLiftEq
instance Ord1 Comprehension where liftCompare = genericLiftCompare
@ -204,7 +219,7 @@ instance Evaluatable Comprehension
-- | A declared type (e.g. `a []int` in Go).
data Type a = Type { typeName :: !a, typeKind :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Type where liftEq = genericLiftEq
instance Ord1 Type where liftCompare = genericLiftCompare
@ -216,11 +231,20 @@ instance Evaluatable Type
-- | Type alias declarations in Javascript/Haskell, etc.
data TypeAlias a = TypeAlias { typeAliasContext :: ![a], typeAliasIdentifier :: !a, typeAliasKind :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 TypeAlias where liftEq = genericLiftEq
instance Ord1 TypeAlias where liftCompare = genericLiftCompare
instance Show1 TypeAlias where liftShowsPrec = genericLiftShowsPrec
-- TODO: Implement Eval instance for TypeAlias
instance Evaluatable TypeAlias
instance Evaluatable TypeAlias where
eval TypeAlias{..} = do
name <- either (throwEvalError . FreeVariablesError) pure (freeVariable (subterm typeAliasIdentifier))
v <- subtermValue typeAliasKind
addr <- lookupOrAlloc name
assign addr v
modifyEnv (Env.insert name addr) $> v
instance Declarations a => Declarations (TypeAlias a) where
declaredName TypeAlias{..} = declaredName typeAliasIdentifier

38
src/Data/Syntax/Expression.hs
View File

@ -9,7 +9,7 @@ import Prologue
-- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell.
data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a], callBlock :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Call where liftEq = genericLiftEq
instance Ord1 Call where liftCompare = genericLiftCompare
@ -27,7 +27,7 @@ data Comparison a
| GreaterThanEqual !a !a
| Equal !a !a
| Comparison !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Comparison where liftEq = genericLiftEq
instance Ord1 Comparison where liftCompare = genericLiftCompare
@ -53,7 +53,7 @@ data Arithmetic a
| Modulo !a !a
| Power !a !a
| Negate !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Arithmetic where liftEq = genericLiftEq
instance Ord1 Arithmetic where liftCompare = genericLiftCompare
@ -74,7 +74,7 @@ instance Evaluatable Arithmetic where
data Match a
= Matches !a !a
| NotMatches !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Match where liftEq = genericLiftEq
instance Ord1 Match where liftCompare = genericLiftCompare
@ -89,7 +89,7 @@ data Boolean a
| And !a !a
| Not !a
| XOr !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Boolean where liftEq = genericLiftEq
instance Ord1 Boolean where liftCompare = genericLiftCompare
@ -109,7 +109,7 @@ instance Evaluatable Boolean where
-- | Javascript delete operator
newtype Delete a = Delete a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Delete where liftEq = genericLiftEq
instance Ord1 Delete where liftCompare = genericLiftCompare
@ -121,7 +121,7 @@ instance Evaluatable Delete
-- | A sequence expression such as Javascript or C's comma operator.
data SequenceExpression a = SequenceExpression { _firstExpression :: !a, _secondExpression :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 SequenceExpression where liftEq = genericLiftEq
instance Ord1 SequenceExpression where liftCompare = genericLiftCompare
@ -133,7 +133,7 @@ instance Evaluatable SequenceExpression
-- | Javascript void operator
newtype Void a = Void a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Void where liftEq = genericLiftEq
instance Ord1 Void where liftCompare = genericLiftCompare
@ -145,7 +145,7 @@ instance Evaluatable Void
-- | Javascript typeof operator
newtype Typeof a = Typeof a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Typeof where liftEq = genericLiftEq
instance Ord1 Typeof where liftCompare = genericLiftCompare
@ -164,7 +164,7 @@ data Bitwise a
| RShift !a !a
| UnsignedRShift !a !a
| Complement a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Bitwise where liftEq = genericLiftEq
instance Ord1 Bitwise where liftCompare = genericLiftCompare
@ -186,7 +186,7 @@ instance Evaluatable Bitwise where
-- | Member Access (e.g. a.b)
data MemberAccess a
= MemberAccess !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 MemberAccess where liftEq = genericLiftEq
instance Ord1 MemberAccess where liftCompare = genericLiftCompare
@ -201,7 +201,7 @@ instance Evaluatable MemberAccess where
data Subscript a
= Subscript !a ![a]
| Member !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Subscript where liftEq = genericLiftEq
instance Ord1 Subscript where liftCompare = genericLiftCompare
@ -213,7 +213,7 @@ instance Evaluatable Subscript
-- | Enumeration (e.g. a[1:10:1] in Python (start at index 1, stop at index 10, step 1 element from start to stop))
data Enumeration a = Enumeration { enumerationStart :: !a, enumerationEnd :: !a, enumerationStep :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Enumeration where liftEq = genericLiftEq
instance Ord1 Enumeration where liftCompare = genericLiftCompare
@ -225,7 +225,7 @@ instance Evaluatable Enumeration
-- | InstanceOf (e.g. a instanceof b in JavaScript
data InstanceOf a = InstanceOf { instanceOfSubject :: !a, instanceOfObject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 InstanceOf where liftEq = genericLiftEq
instance Ord1 InstanceOf where liftCompare = genericLiftCompare
@ -237,7 +237,7 @@ instance Evaluatable InstanceOf
-- | ScopeResolution (e.g. import a.b in Python or a::b in C++)
newtype ScopeResolution a = ScopeResolution [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ScopeResolution where liftEq = genericLiftEq
instance Ord1 ScopeResolution where liftCompare = genericLiftCompare
@ -249,7 +249,7 @@ instance Evaluatable ScopeResolution
-- | A non-null expression such as Typescript or Swift's ! expression.
newtype NonNullExpression a = NonNullExpression { nonNullExpression :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 NonNullExpression where liftEq = genericLiftEq
instance Ord1 NonNullExpression where liftCompare = genericLiftCompare
@ -261,7 +261,7 @@ instance Evaluatable NonNullExpression
-- | An await expression in Javascript or C#.
newtype Await a = Await { awaitSubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Await where liftEq = genericLiftEq
instance Ord1 Await where liftCompare = genericLiftCompare
@ -273,7 +273,7 @@ instance Evaluatable Await
-- | An object constructor call in Javascript, Java, etc.
newtype New a = New { newSubject :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 New where liftEq = genericLiftEq
instance Ord1 New where liftCompare = genericLiftCompare
@ -285,7 +285,7 @@ instance Evaluatable New
-- | A cast expression to a specified type.
data Cast a = Cast { castSubject :: !a, castType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Cast where liftEq = genericLiftEq
instance Ord1 Cast where liftCompare = genericLiftCompare

54
src/Data/Syntax/Literal.hs
View File

@ -7,14 +7,14 @@ import Data.ByteString.Char8 (readInteger, unpack)
import qualified Data.ByteString.Char8 as B
import Data.Scientific.Exts
import Diffing.Algorithm
import Prelude hiding (Float, fail, null)
import Prelude hiding (Float, null)
import Prologue hiding (Set, hash, null)
import Text.Read (readMaybe)
-- Boolean
newtype Boolean a = Boolean Bool
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
true :: Boolean a
true = Boolean True
@ -34,7 +34,7 @@ instance Evaluatable Boolean where
-- | A literal integer of unspecified width. No particular base is implied.
newtype Integer a = Integer { integerContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Data.Syntax.Literal.Integer where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Literal.Integer where liftCompare = genericLiftCompare
@ -42,7 +42,8 @@ instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShow
instance Evaluatable Data.Syntax.Literal.Integer where
-- TODO: This instance probably shouldn't have readInteger?
eval (Data.Syntax.Literal.Integer x) = integer (maybe 0 fst (readInteger x))
eval (Data.Syntax.Literal.Integer x) =
integer =<< maybeM (throwEvalError (IntegerFormatError x)) (fst <$> readInteger x)
-- TODO: Should IntegerLiteral hold an Integer instead of a ByteString?
@ -51,7 +52,7 @@ instance Evaluatable Data.Syntax.Literal.Integer where
-- | A literal float of unspecified width.
newtype Float a = Float { floatContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Data.Syntax.Literal.Float where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Literal.Float where liftCompare = genericLiftCompare
@ -59,28 +60,27 @@ instance Show1 Data.Syntax.Literal.Float where liftShowsPrec = genericLiftShowsP
instance Evaluatable Data.Syntax.Literal.Float where
eval (Float s) =
case parseScientific s of
Right num -> float num
Left err -> fail ("Parse error: " <> err)
float =<< either (const (throwEvalError (FloatFormatError s))) pure (parseScientific s)
-- Rational literals e.g. `2/3r`
newtype Rational a = Rational ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Data.Syntax.Literal.Rational where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Literal.Rational where liftCompare = genericLiftCompare
instance Show1 Data.Syntax.Literal.Rational where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Data.Syntax.Literal.Rational where
eval (Rational r) = let trimmed = B.takeWhile (/= 'r') r in
case readMaybe @Prelude.Integer (unpack trimmed) of
Just i -> rational (toRational i)
Nothing -> fail ("Bug: invalid rational " <> show r)
eval (Rational r) =
let
trimmed = B.takeWhile (/= 'r') r
parsed = readMaybe @Prelude.Integer (unpack trimmed)
in rational =<< maybe (throwEvalError (RationalFormatError r)) (pure . toRational) parsed
-- Complex literals e.g. `3 + 2i`
newtype Complex a = Complex ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Data.Syntax.Literal.Complex where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Literal.Complex where liftCompare = genericLiftCompare
@ -92,7 +92,7 @@ instance Evaluatable Complex
-- Strings, symbols
newtype String a = String { stringElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Data.Syntax.Literal.String where liftEq = genericLiftEq
instance Ord1 Data.Syntax.Literal.String where liftCompare = genericLiftCompare
@ -106,7 +106,7 @@ instance Evaluatable Data.Syntax.Literal.String
-- | An interpolation element within a string literal.
newtype InterpolationElement a = InterpolationElement { interpolationBody :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 InterpolationElement where liftEq = genericLiftEq
instance Ord1 InterpolationElement where liftCompare = genericLiftCompare
@ -118,7 +118,7 @@ instance Evaluatable InterpolationElement
-- | A sequence of textual contents within a string literal.
newtype TextElement a = TextElement { textElementContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 TextElement where liftEq = genericLiftEq
instance Ord1 TextElement where liftCompare = genericLiftCompare
@ -128,7 +128,7 @@ instance Evaluatable TextElement where
eval (TextElement x) = string x
data Null a = Null
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Null where liftEq = genericLiftEq
instance Ord1 Null where liftCompare = genericLiftCompare
@ -137,7 +137,7 @@ instance Show1 Null where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Null where eval = const null
newtype Symbol a = Symbol { symbolContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Symbol where liftEq = genericLiftEq
instance Ord1 Symbol where liftCompare = genericLiftCompare
@ -147,7 +147,7 @@ instance Evaluatable Symbol where
eval (Symbol s) = symbol s
newtype Regex a = Regex { regexContent :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Regex where liftEq = genericLiftEq
instance Ord1 Regex where liftCompare = genericLiftCompare
@ -163,7 +163,7 @@ instance Evaluatable Regex
-- Collections
newtype Array a = Array { arrayElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Array where liftEq = genericLiftEq
instance Ord1 Array where liftCompare = genericLiftCompare
@ -173,7 +173,7 @@ instance Evaluatable Array where
eval (Array a) = array =<< traverse subtermValue a
newtype Hash a = Hash { hashElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Hash where liftEq = genericLiftEq
instance Ord1 Hash where liftCompare = genericLiftCompare
@ -183,7 +183,7 @@ instance Evaluatable Hash where
eval = hashElements >>> traverse (subtermValue >=> asPair) >=> hash
data KeyValue a = KeyValue { key :: !a, value :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 KeyValue where liftEq = genericLiftEq
instance Ord1 KeyValue where liftCompare = genericLiftCompare
@ -194,7 +194,7 @@ instance Evaluatable KeyValue where
join (kvPair <$> key <*> value)
newtype Tuple a = Tuple { tupleContents :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Tuple where liftEq = genericLiftEq
instance Ord1 Tuple where liftCompare = genericLiftCompare
@ -204,7 +204,7 @@ instance Evaluatable Tuple where
eval (Tuple cs) = multiple =<< traverse subtermValue cs
newtype Set a = Set { setElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Set where liftEq = genericLiftEq
instance Ord1 Set where liftCompare = genericLiftCompare
@ -218,7 +218,7 @@ instance Evaluatable Set
-- | A declared pointer (e.g. var pointer *int in Go)
newtype Pointer a = Pointer a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Pointer where liftEq = genericLiftEq
instance Ord1 Pointer where liftCompare = genericLiftCompare
@ -230,7 +230,7 @@ instance Evaluatable Pointer
-- | A reference to a pointer's address (e.g. &pointer in Go)
newtype Reference a = Reference a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Reference where liftEq = genericLiftEq
instance Ord1 Reference where liftCompare = genericLiftCompare

52
src/Data/Syntax/Statement.hs
View File

@ -9,7 +9,7 @@ import Prologue
-- | Conditional. This must have an else block, which can be filled with some default value when omitted in the source, e.g. 'pure ()' for C-style if-without-else or 'pure Nothing' for Ruby-style, in both cases assuming some appropriate Applicative context into which the If will be lifted.
data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 If where liftEq = genericLiftEq
instance Ord1 If where liftCompare = genericLiftCompare
@ -22,7 +22,7 @@ instance Evaluatable If where
-- | Else statement. The else condition is any term, that upon successful completion, continues evaluation to the elseBody, e.g. `for ... else` in Python.
data Else a = Else { elseCondition :: !a, elseBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Else where liftEq = genericLiftEq
instance Ord1 Else where liftCompare = genericLiftCompare
@ -35,7 +35,7 @@ instance Evaluatable Else
-- | Goto statement (e.g. `goto a` in Go).
newtype Goto a = Goto { gotoLocation :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Goto where liftEq = genericLiftEq
instance Ord1 Goto where liftCompare = genericLiftCompare
@ -47,7 +47,7 @@ instance Evaluatable Goto
-- | A pattern-matching or computed jump control-flow statement, like 'switch' in C or JavaScript, or 'case' in Ruby or Haskell.
data Match a = Match { matchSubject :: !a, matchPatterns :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Match where liftEq = genericLiftEq
instance Ord1 Match where liftCompare = genericLiftCompare
@ -59,7 +59,7 @@ instance Evaluatable Match
-- | A pattern in a pattern-matching or computed jump control-flow statement, like 'case' in C or JavaScript, 'when' in Ruby, or the left-hand side of '->' in the body of Haskell 'case' expressions.
data Pattern a = Pattern { _pattern :: !a, patternBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Pattern where liftEq = genericLiftEq
instance Ord1 Pattern where liftCompare = genericLiftCompare
@ -71,7 +71,7 @@ instance Evaluatable Pattern
-- | A let statement or local binding, like 'a as b' or 'let a = b'.
data Let a = Let { letVariable :: !a, letValue :: !a, letBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Let where liftEq = genericLiftEq
instance Ord1 Let where liftCompare = genericLiftCompare
@ -88,7 +88,7 @@ instance Evaluatable Let where
-- | Assignment to a variable or other lvalue.
data Assignment a = Assignment { assignmentContext :: ![a], assignmentTarget :: !a, assignmentValue :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Assignment where liftEq = genericLiftEq
instance Ord1 Assignment where liftCompare = genericLiftCompare
@ -108,7 +108,7 @@ instance Evaluatable Assignment where
-- | Post increment operator (e.g. 1++ in Go, or i++ in C).
newtype PostIncrement a = PostIncrement a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 PostIncrement where liftEq = genericLiftEq
instance Ord1 PostIncrement where liftCompare = genericLiftCompare
@ -120,7 +120,7 @@ instance Evaluatable PostIncrement
-- | Post decrement operator (e.g. 1-- in Go, or i-- in C).
newtype PostDecrement a = PostDecrement a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 PostDecrement where liftEq = genericLiftEq
instance Ord1 PostDecrement where liftCompare = genericLiftCompare
@ -133,7 +133,7 @@ instance Evaluatable PostDecrement
-- Returns
newtype Return a = Return a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Return where liftEq = genericLiftEq
instance Ord1 Return where liftCompare = genericLiftCompare
@ -143,7 +143,7 @@ instance Evaluatable Return where
eval (Return x) = subtermValue x
newtype Yield a = Yield a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Yield where liftEq = genericLiftEq
instance Ord1 Yield where liftCompare = genericLiftCompare
@ -154,7 +154,7 @@ instance Evaluatable Yield
newtype Break a = Break a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Break where liftEq = genericLiftEq
instance Ord1 Break where liftCompare = genericLiftCompare
@ -165,7 +165,7 @@ instance Evaluatable Break
newtype Continue a = Continue a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Continue where liftEq = genericLiftEq
instance Ord1 Continue where liftCompare = genericLiftCompare
@ -176,7 +176,7 @@ instance Evaluatable Continue
newtype Retry a = Retry a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Retry where liftEq = genericLiftEq
instance Ord1 Retry where liftCompare = genericLiftCompare
@ -187,7 +187,7 @@ instance Evaluatable Retry
newtype NoOp a = NoOp a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 NoOp where liftEq = genericLiftEq
instance Ord1 NoOp where liftCompare = genericLiftCompare
@ -199,7 +199,7 @@ instance Evaluatable NoOp where
-- Loops
data For a = For { forBefore :: !a, forCondition :: !a, forStep :: !a, forBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 For where liftEq = genericLiftEq
instance Ord1 For where liftCompare = genericLiftCompare
@ -210,7 +210,7 @@ instance Evaluatable For where
data ForEach a = ForEach { forEachBinding :: !a, forEachSubject :: !a, forEachBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ForEach where liftEq = genericLiftEq
instance Ord1 ForEach where liftCompare = genericLiftCompare
@ -221,7 +221,7 @@ instance Evaluatable ForEach
data While a = While { whileCondition :: !a, whileBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 While where liftEq = genericLiftEq
instance Ord1 While where liftCompare = genericLiftCompare
@ -231,7 +231,7 @@ instance Evaluatable While where
eval While{..} = while (subtermValue whileCondition) (subtermValue whileBody)
data DoWhile a = DoWhile { doWhileCondition :: !a, doWhileBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 DoWhile where liftEq = genericLiftEq
instance Ord1 DoWhile where liftCompare = genericLiftCompare
@ -243,7 +243,7 @@ instance Evaluatable DoWhile where
-- Exception handling
newtype Throw a = Throw a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Throw where liftEq = genericLiftEq
instance Ord1 Throw where liftCompare = genericLiftCompare
@ -254,7 +254,7 @@ instance Evaluatable Throw
data Try a = Try { tryBody :: !a, tryCatch :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Try where liftEq = genericLiftEq
instance Ord1 Try where liftCompare = genericLiftCompare
@ -265,7 +265,7 @@ instance Evaluatable Try
data Catch a = Catch { catchException :: !a, catchBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Catch where liftEq = genericLiftEq
instance Ord1 Catch where liftCompare = genericLiftCompare
@ -276,7 +276,7 @@ instance Evaluatable Catch
newtype Finally a = Finally a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Finally where liftEq = genericLiftEq
instance Ord1 Finally where liftCompare = genericLiftCompare
@ -290,7 +290,7 @@ instance Evaluatable Finally
-- | ScopeEntry (e.g. `BEGIN {}` block in Ruby or Perl).
newtype ScopeEntry a = ScopeEntry [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ScopeEntry where liftEq = genericLiftEq
instance Ord1 ScopeEntry where liftCompare = genericLiftCompare
@ -302,7 +302,7 @@ instance Evaluatable ScopeEntry
-- | ScopeExit (e.g. `END {}` block in Ruby or Perl).
newtype ScopeExit a = ScopeExit [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ScopeExit where liftEq = genericLiftEq
instance Ord1 ScopeExit where liftCompare = genericLiftCompare
@ -313,7 +313,7 @@ instance Evaluatable ScopeExit
-- | HashBang line (e.g. `#!/usr/bin/env node`)
newtype HashBang a = HashBang ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 HashBang where liftEq = genericLiftEq
instance Ord1 HashBang where liftCompare = genericLiftCompare

22
src/Data/Syntax/Type.hs
View File

@ -6,7 +6,7 @@ import Diffing.Algorithm
import Prologue hiding (Map)
data Array a = Array { arraySize :: Maybe a, arrayElementType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Array where liftEq = genericLiftEq
instance Ord1 Array where liftCompare = genericLiftCompare
@ -18,7 +18,7 @@ instance Evaluatable Array
-- TODO: What about type variables? re: FreeVariables1
data Annotation a = Annotation { annotationSubject :: !a, annotationType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Annotation where liftEq = genericLiftEq
instance Ord1 Annotation where liftCompare = genericLiftCompare
@ -30,7 +30,7 @@ instance Evaluatable Annotation where
data Function a = Function { functionParameters :: [a], functionReturn :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Function where liftEq = genericLiftEq
instance Ord1 Function where liftCompare = genericLiftCompare
@ -41,7 +41,7 @@ instance Evaluatable Function
newtype Interface a = Interface [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Interface where liftEq = genericLiftEq
instance Ord1 Interface where liftCompare = genericLiftCompare
@ -52,7 +52,7 @@ instance Evaluatable Interface
data Map a = Map { mapKeyType :: a, mapElementType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Map where liftEq = genericLiftEq
instance Ord1 Map where liftCompare = genericLiftCompare
@ -63,7 +63,7 @@ instance Evaluatable Map
newtype Parenthesized a = Parenthesized a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Parenthesized where liftEq = genericLiftEq
instance Ord1 Parenthesized where liftCompare = genericLiftCompare
@ -74,7 +74,7 @@ instance Evaluatable Parenthesized
newtype Pointer a = Pointer a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Pointer where liftEq = genericLiftEq
instance Ord1 Pointer where liftCompare = genericLiftCompare
@ -85,7 +85,7 @@ instance Evaluatable Pointer
newtype Product a = Product [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Product where liftEq = genericLiftEq
instance Ord1 Product where liftCompare = genericLiftCompare
@ -96,7 +96,7 @@ instance Evaluatable Product
data Readonly a = Readonly
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Readonly where liftEq = genericLiftEq
instance Ord1 Readonly where liftCompare = genericLiftCompare
@ -107,7 +107,7 @@ instance Evaluatable Readonly
newtype Slice a = Slice a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Slice where liftEq = genericLiftEq
instance Ord1 Slice where liftCompare = genericLiftCompare
@ -118,7 +118,7 @@ instance Evaluatable Slice
newtype TypeParameters a = TypeParameters [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 TypeParameters where liftEq = genericLiftEq
instance Ord1 TypeParameters where liftCompare = genericLiftCompare

53
src/Language/Go/Syntax.hs
View File

@ -3,6 +3,7 @@ module Language.Go.Syntax where
import Data.Abstract.Evaluatable hiding (Label)
import Data.Abstract.Module
import Data.Abstract.Path
import Data.Abstract.FreeVariables (name)
import Diffing.Algorithm
import qualified Data.ByteString.Char8 as BC
@ -24,14 +25,14 @@ defaultAlias = name . BC.pack . takeFileName . unPath
resolveGoImport :: MonadEvaluatable location term value m => FilePath -> m [ModulePath]
resolveGoImport relImportPath = do
ModuleInfo{..} <- currentModule
let relRootDir = takeDirectory (makeRelative moduleRoot modulePath)
listModulesInDir $ normalise (relRootDir </> normalise relImportPath)
let relRootDir = takeDirectory modulePath
listModulesInDir (joinPaths relRootDir relImportPath)
-- | Import declarations (symbols are added directly to the calling environment).
--
-- If the list of symbols is empty copy everything to the calling environment.
data Import a = Import { importFrom :: ImportPath, importWildcardToken :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Import where liftEq = genericLiftEq
instance Ord1 Import where liftCompare = genericLiftCompare
@ -41,7 +42,7 @@ instance Evaluatable Import where
eval (Import (ImportPath name) _) = do
paths <- resolveGoImport name
for_ paths $ \path -> do
(importedEnv, _) <- isolate (require path)
(importedEnv, _) <- traceResolve name path $ isolate (require path)
modifyEnv (mappend importedEnv)
unit
@ -50,7 +51,7 @@ instance Evaluatable Import where
--
-- If the list of symbols is empty copy and qualify everything to the calling environment.
data QualifiedImport a = QualifiedImport { qualifiedImportFrom :: !ImportPath, qualifiedImportAlias :: !a}
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 QualifiedImport where liftEq = genericLiftEq
instance Ord1 QualifiedImport where liftCompare = genericLiftCompare
@ -62,7 +63,7 @@ instance Evaluatable QualifiedImport where
alias <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm aliasTerm)
void $ letrec' alias $ \addr -> do
for_ paths $ \path -> do
(importedEnv, _) <- isolate (require path)
(importedEnv, _) <- traceResolve name path $ isolate (require path)
modifyEnv (mappend importedEnv)
makeNamespace alias addr []
@ -70,7 +71,7 @@ instance Evaluatable QualifiedImport where
-- | Side effect only imports (no symbols made available to the calling environment).
data SideEffectImport a = SideEffectImport { sideEffectImportFrom :: !ImportPath, sideEffectImportToken :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 SideEffectImport where liftEq = genericLiftEq
instance Ord1 SideEffectImport where liftCompare = genericLiftCompare
@ -79,12 +80,12 @@ instance Show1 SideEffectImport where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable SideEffectImport where
eval (SideEffectImport (ImportPath name) _) = do
paths <- resolveGoImport name
for_ paths (isolate . require)
for_ paths $ \path -> traceResolve name path $ isolate (require path)
unit
-- A composite literal in Go
data Composite a = Composite { compositeType :: !a, compositeElement :: !a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Composite where liftEq = genericLiftEq
instance Ord1 Composite where liftCompare = genericLiftCompare
@ -95,7 +96,7 @@ instance Evaluatable Composite
-- | A default pattern in a Go select or switch statement (e.g. `switch { default: s() }`).
newtype DefaultPattern a = DefaultPattern { defaultPatternBody :: a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 DefaultPattern where liftEq = genericLiftEq
instance Ord1 DefaultPattern where liftCompare = genericLiftCompare
@ -106,7 +107,7 @@ instance Evaluatable DefaultPattern
-- | A defer statement in Go (e.g. `defer x()`).
newtype Defer a = Defer { deferBody :: a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Defer where liftEq = genericLiftEq
instance Ord1 Defer where liftCompare = genericLiftCompare
@ -117,7 +118,7 @@ instance Evaluatable Defer
-- | A go statement (i.e. go routine) in Go (e.g. `go x()`).
newtype Go a = Go { goBody :: a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Go where liftEq = genericLiftEq
instance Ord1 Go where liftCompare = genericLiftCompare
@ -128,7 +129,7 @@ instance Evaluatable Go
-- | A label statement in Go (e.g. `label:continue`).
data Label a = Label { _labelName :: !a, labelStatement :: !a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Label where liftEq = genericLiftEq
instance Ord1 Label where liftCompare = genericLiftCompare
@ -139,7 +140,7 @@ instance Evaluatable Label
-- | A rune literal in Go (e.g. `'⌘'`).
newtype Rune a = Rune { _runeLiteral :: ByteString }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-- TODO: Implement Eval instance for Rune
instance Evaluatable Rune
@ -150,7 +151,7 @@ instance Show1 Rune where liftShowsPrec = genericLiftShowsPrec
-- | A select statement in Go (e.g. `select { case x := <-c: x() }` where each case is a send or receive operation on channels).
newtype Select a = Select { selectCases :: a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
-- TODO: Implement Eval instance for Select
instance Evaluatable Select
@ -161,7 +162,7 @@ instance Show1 Select where liftShowsPrec = genericLiftShowsPrec
-- | A send statement in Go (e.g. `channel <- value`).
data Send a = Send { sendReceiver :: !a, sendValue :: !a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Send where liftEq = genericLiftEq
instance Ord1 Send where liftCompare = genericLiftCompare
@ -172,7 +173,7 @@ instance Evaluatable Send
-- | A slice expression in Go (e.g. `a[1:4:3]` where a is a list, 1 is the low bound, 4 is the high bound, and 3 is the max capacity).
data Slice a = Slice { sliceName :: !a, sliceLow :: !a, sliceHigh :: !a, sliceCapacity :: !a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Slice where liftEq = genericLiftEq
instance Ord1 Slice where liftCompare = genericLiftCompare
@ -183,7 +184,7 @@ instance Evaluatable Slice
-- | A type switch statement in Go (e.g. `switch x.(type) { // cases }`).
data TypeSwitch a = TypeSwitch { typeSwitchSubject :: !a, typeSwitchCases :: !a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeSwitch where liftEq = genericLiftEq
instance Ord1 TypeSwitch where liftCompare = genericLiftCompare
@ -194,7 +195,7 @@ instance Evaluatable TypeSwitch
-- | A type switch guard statement in a Go type switch statement (e.g. `switch i := x.(type) { // cases}`).
newtype TypeSwitchGuard a = TypeSwitchGuard { typeSwitchGuardSubject :: a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeSwitchGuard where liftEq = genericLiftEq
instance Ord1 TypeSwitchGuard where liftCompare = genericLiftCompare
@ -205,7 +206,7 @@ instance Evaluatable TypeSwitchGuard
-- | A receive statement in a Go select statement (e.g. `case value := <-channel` )
data Receive a = Receive { receiveSubject :: !a, receiveExpression :: !a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Receive where liftEq = genericLiftEq
instance Ord1 Receive where liftCompare = genericLiftCompare
@ -216,7 +217,7 @@ instance Evaluatable Receive
-- | A receive operator unary expression in Go (e.g. `<-channel` )
newtype ReceiveOperator a = ReceiveOperator a
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ReceiveOperator where liftEq = genericLiftEq
instance Ord1 ReceiveOperator where liftCompare = genericLiftCompare
@ -227,7 +228,7 @@ instance Evaluatable ReceiveOperator
-- | A field declaration in a Go struct type declaration.
data Field a = Field { fieldContext :: ![a], fieldName :: !a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Field where liftEq = genericLiftEq
instance Ord1 Field where liftCompare = genericLiftCompare
@ -238,7 +239,7 @@ instance Evaluatable Field
data Package a = Package { packageName :: !a, packageContents :: ![a] }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Package where liftEq = genericLiftEq
instance Ord1 Package where liftCompare = genericLiftCompare
@ -250,7 +251,7 @@ instance Evaluatable Package where
-- | A type assertion in Go (e.g. `x.(T)` where the value of `x` is not nil and is of type `T`).
data TypeAssertion a = TypeAssertion { typeAssertionSubject :: !a, typeAssertionType :: !a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeAssertion where liftEq = genericLiftEq
instance Ord1 TypeAssertion where liftCompare = genericLiftCompare
@ -261,7 +262,7 @@ instance Evaluatable TypeAssertion
-- | A type conversion expression in Go (e.g. `T(x)` where `T` is a type and `x` is an expression that can be converted to type `T`).
data TypeConversion a = TypeConversion { typeConversionType :: !a, typeConversionSubject :: !a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeConversion where liftEq = genericLiftEq
instance Ord1 TypeConversion where liftCompare = genericLiftCompare
@ -272,7 +273,7 @@ instance Evaluatable TypeConversion
-- | Variadic arguments and parameters in Go (e.g. parameter: `param ...Type`, argument: `Type...`).
data Variadic a = Variadic { variadicContext :: [a], variadicIdentifier :: a }
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Variadic where liftEq = genericLiftEq
instance Ord1 Variadic where liftCompare = genericLiftCompare

6
src/Language/Go/Type.hs
View File

@ -7,7 +7,7 @@ import Diffing.Algorithm
-- | A Bidirectional channel in Go (e.g. `chan`).
newtype BidirectionalChannel a = BidirectionalChannel a
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 BidirectionalChannel where liftEq = genericLiftEq
instance Ord1 BidirectionalChannel where liftCompare = genericLiftCompare
@ -18,7 +18,7 @@ instance Evaluatable BidirectionalChannel
-- | A Receive channel in Go (e.g. `<-chan`).
newtype ReceiveChannel a = ReceiveChannel a
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ReceiveChannel where liftEq = genericLiftEq
instance Ord1 ReceiveChannel where liftCompare = genericLiftCompare
@ -29,7 +29,7 @@ instance Evaluatable ReceiveChannel
-- | A Send channel in Go (e.g. `chan<-`).
newtype SendChannel a = SendChannel a
deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, FreeVariables1, Declarations1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 SendChannel where liftEq = genericLiftEq
instance Ord1 SendChannel where liftCompare = genericLiftCompare

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

@ -10,7 +10,7 @@ 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)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Text where liftEq = genericLiftEq
instance Ord1 Text where liftCompare = genericLiftCompare
@ -19,7 +19,7 @@ instance Evaluatable Text
newtype VariableName a = VariableName a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 VariableName where liftEq = genericLiftEq
instance Ord1 VariableName where liftCompare = genericLiftCompare
@ -44,7 +44,7 @@ doInclude :: MonadEvaluatable location term value m => Subterm t (m value) -> m
doInclude pathTerm = do
name <- subtermValue pathTerm >>= asString
path <- resolvePHPName name
(importedEnv, v) <- isolate (load path)
(importedEnv, v) <- traceResolve name path $ isolate (load path)
modifyEnv (mappend importedEnv)
pure v
@ -52,12 +52,12 @@ doIncludeOnce :: MonadEvaluatable location term value m => Subterm t (m value) -
doIncludeOnce pathTerm = do
name <- subtermValue pathTerm >>= asString
path <- resolvePHPName name
(importedEnv, v) <- isolate (require path)
(importedEnv, v) <- traceResolve name path $ isolate (require path)
modifyEnv (mappend importedEnv)
pure v
newtype Require a = Require a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Require where liftEq = genericLiftEq
instance Ord1 Require where liftCompare = genericLiftCompare
@ -68,7 +68,7 @@ instance Evaluatable Require where
newtype RequireOnce a = RequireOnce a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 RequireOnce where liftEq = genericLiftEq
instance Ord1 RequireOnce where liftCompare = genericLiftCompare
@ -79,7 +79,7 @@ instance Evaluatable RequireOnce where
newtype Include a = Include a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Include where liftEq = genericLiftEq
instance Ord1 Include where liftCompare = genericLiftCompare
@ -90,7 +90,7 @@ instance Evaluatable Include where
newtype IncludeOnce a = IncludeOnce a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 IncludeOnce where liftEq = genericLiftEq
instance Ord1 IncludeOnce where liftCompare = genericLiftCompare
@ -101,7 +101,7 @@ instance Evaluatable IncludeOnce where
newtype ArrayElement a = ArrayElement a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ArrayElement where liftEq = genericLiftEq
instance Ord1 ArrayElement where liftCompare = genericLiftCompare
@ -109,7 +109,7 @@ instance Show1 ArrayElement where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ArrayElement
newtype GlobalDeclaration a = GlobalDeclaration [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 GlobalDeclaration where liftEq = genericLiftEq
instance Ord1 GlobalDeclaration where liftCompare = genericLiftCompare
@ -117,7 +117,7 @@ instance Show1 GlobalDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable GlobalDeclaration
newtype SimpleVariable a = SimpleVariable a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 SimpleVariable where liftEq = genericLiftEq
instance Ord1 SimpleVariable where liftCompare = genericLiftCompare
@ -127,7 +127,7 @@ instance Evaluatable SimpleVariable
-- | TODO: Unify with TypeScript's PredefinedType
newtype CastType a = CastType { _castType :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 CastType where liftEq = genericLiftEq
instance Ord1 CastType where liftCompare = genericLiftCompare
@ -135,7 +135,7 @@ instance Show1 CastType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable CastType
newtype ErrorControl a = ErrorControl a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ErrorControl where liftEq = genericLiftEq
instance Ord1 ErrorControl where liftCompare = genericLiftCompare
@ -143,7 +143,7 @@ instance Show1 ErrorControl where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ErrorControl
newtype Clone a = Clone a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Clone where liftEq = genericLiftEq
instance Ord1 Clone where liftCompare = genericLiftCompare
@ -151,7 +151,7 @@ instance Show1 Clone where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Clone
newtype ShellCommand a = ShellCommand ByteString
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ShellCommand where liftEq = genericLiftEq
instance Ord1 ShellCommand where liftCompare = genericLiftCompare
@ -160,7 +160,7 @@ instance Evaluatable ShellCommand
-- | TODO: Combine with TypeScript update expression.
newtype Update a = Update { _updateSubject :: a }
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Update where liftEq = genericLiftEq
instance Ord1 Update where liftCompare = genericLiftCompare
@ -168,7 +168,7 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Update
newtype NewVariable a = NewVariable [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 NewVariable where liftEq = genericLiftEq
instance Ord1 NewVariable where liftCompare = genericLiftCompare
@ -176,7 +176,7 @@ instance Show1 NewVariable where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable NewVariable
newtype RelativeScope a = RelativeScope ByteString
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 RelativeScope where liftEq = genericLiftEq
instance Ord1 RelativeScope where liftCompare = genericLiftCompare
@ -184,7 +184,7 @@ instance Show1 RelativeScope where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable RelativeScope
data QualifiedName a = QualifiedName !a !a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 QualifiedName where liftEq = genericLiftEq
instance Ord1 QualifiedName where liftCompare = genericLiftCompare
@ -197,7 +197,7 @@ instance Evaluatable QualifiedName where
newtype NamespaceName a = NamespaceName (NonEmpty a)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 NamespaceName where liftEq = genericLiftEq
instance Ord1 NamespaceName where liftCompare = genericLiftCompare
@ -211,7 +211,7 @@ instance Evaluatable NamespaceName where
localEnv (mappend env) nam
newtype ConstDeclaration a = ConstDeclaration [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ConstDeclaration where liftEq = genericLiftEq
instance Ord1 ConstDeclaration where liftCompare = genericLiftCompare
@ -219,7 +219,7 @@ instance Show1 ConstDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ConstDeclaration
data ClassConstDeclaration a = ClassConstDeclaration a [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ClassConstDeclaration where liftEq = genericLiftEq
instance Ord1 ClassConstDeclaration where liftCompare = genericLiftCompare
@ -227,7 +227,7 @@ instance Show1 ClassConstDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ClassConstDeclaration
newtype ClassInterfaceClause a = ClassInterfaceClause [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ClassInterfaceClause where liftEq = genericLiftEq
instance Ord1 ClassInterfaceClause where liftCompare = genericLiftCompare
@ -235,7 +235,7 @@ instance Show1 ClassInterfaceClause where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ClassInterfaceClause
newtype ClassBaseClause a = ClassBaseClause a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ClassBaseClause where liftEq = genericLiftEq
instance Ord1 ClassBaseClause where liftCompare = genericLiftCompare
@ -244,7 +244,7 @@ instance Evaluatable ClassBaseClause
newtype UseClause a = UseClause [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 UseClause where liftEq = genericLiftEq
instance Ord1 UseClause where liftCompare = genericLiftCompare
@ -252,7 +252,7 @@ instance Show1 UseClause where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable UseClause
newtype ReturnType a = ReturnType a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ReturnType where liftEq = genericLiftEq
instance Ord1 ReturnType where liftCompare = genericLiftCompare
@ -260,7 +260,7 @@ instance Show1 ReturnType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ReturnType
newtype TypeDeclaration a = TypeDeclaration a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TypeDeclaration where liftEq = genericLiftEq
instance Ord1 TypeDeclaration where liftCompare = genericLiftCompare
@ -268,7 +268,7 @@ instance Show1 TypeDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable TypeDeclaration
newtype BaseTypeDeclaration a = BaseTypeDeclaration a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 BaseTypeDeclaration where liftEq = genericLiftEq
instance Ord1 BaseTypeDeclaration where liftCompare = genericLiftCompare
@ -276,7 +276,7 @@ instance Show1 BaseTypeDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable BaseTypeDeclaration
newtype ScalarType a = ScalarType ByteString
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ScalarType where liftEq = genericLiftEq
instance Ord1 ScalarType where liftCompare = genericLiftCompare
@ -284,7 +284,7 @@ instance Show1 ScalarType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ScalarType
newtype EmptyIntrinsic a = EmptyIntrinsic a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 EmptyIntrinsic where liftEq = genericLiftEq
instance Ord1 EmptyIntrinsic where liftCompare = genericLiftCompare
@ -292,7 +292,7 @@ instance Show1 EmptyIntrinsic where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable EmptyIntrinsic
newtype ExitIntrinsic a = ExitIntrinsic a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ExitIntrinsic where liftEq = genericLiftEq
instance Ord1 ExitIntrinsic where liftCompare = genericLiftCompare
@ -300,7 +300,7 @@ instance Show1 ExitIntrinsic where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ExitIntrinsic
newtype IssetIntrinsic a = IssetIntrinsic a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 IssetIntrinsic where liftEq = genericLiftEq
instance Ord1 IssetIntrinsic where liftCompare = genericLiftCompare
@ -308,7 +308,7 @@ instance Show1 IssetIntrinsic where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable IssetIntrinsic
newtype EvalIntrinsic a = EvalIntrinsic a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 EvalIntrinsic where liftEq = genericLiftEq
instance Ord1 EvalIntrinsic where liftCompare = genericLiftCompare
@ -316,7 +316,7 @@ instance Show1 EvalIntrinsic where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable EvalIntrinsic
newtype PrintIntrinsic a = PrintIntrinsic a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 PrintIntrinsic where liftEq = genericLiftEq
instance Ord1 PrintIntrinsic where liftCompare = genericLiftCompare
@ -324,7 +324,7 @@ instance Show1 PrintIntrinsic where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable PrintIntrinsic
newtype NamespaceAliasingClause a = NamespaceAliasingClause a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 NamespaceAliasingClause where liftEq = genericLiftEq
instance Ord1 NamespaceAliasingClause where liftCompare = genericLiftCompare
@ -332,7 +332,7 @@ instance Show1 NamespaceAliasingClause where liftShowsPrec = genericLiftShowsPre
instance Evaluatable NamespaceAliasingClause
newtype NamespaceUseDeclaration a = NamespaceUseDeclaration [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 NamespaceUseDeclaration where liftEq = genericLiftEq
instance Ord1 NamespaceUseDeclaration where liftCompare = genericLiftCompare
@ -340,7 +340,7 @@ instance Show1 NamespaceUseDeclaration where liftShowsPrec = genericLiftShowsPre
instance Evaluatable NamespaceUseDeclaration
newtype NamespaceUseClause a = NamespaceUseClause [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 NamespaceUseClause where liftEq = genericLiftEq
instance Ord1 NamespaceUseClause where liftCompare = genericLiftCompare
@ -348,7 +348,7 @@ instance Show1 NamespaceUseClause where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable NamespaceUseClause
newtype NamespaceUseGroupClause a = NamespaceUseGroupClause [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 NamespaceUseGroupClause where liftEq = genericLiftEq
instance Ord1 NamespaceUseGroupClause where liftCompare = genericLiftCompare
@ -356,7 +356,7 @@ instance Show1 NamespaceUseGroupClause where liftShowsPrec = genericLiftShowsPre
instance Evaluatable NamespaceUseGroupClause
data Namespace a = Namespace { namespaceName :: a, namespaceBody :: a }
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Namespace where liftEq = genericLiftEq
instance Ord1 Namespace where liftCompare = genericLiftCompare
@ -375,7 +375,7 @@ instance Evaluatable Namespace where
go xs <* makeNamespace name addr []
data TraitDeclaration a = TraitDeclaration { traitName :: a, traitStatements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TraitDeclaration where liftEq = genericLiftEq
instance Ord1 TraitDeclaration where liftCompare = genericLiftCompare
@ -383,7 +383,7 @@ instance Show1 TraitDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable TraitDeclaration
data AliasAs a = AliasAs { aliasAsName :: a, aliasAsModifier :: a, aliasAsClause :: a }
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 AliasAs where liftEq = genericLiftEq
instance Ord1 AliasAs where liftCompare = genericLiftCompare
@ -391,7 +391,7 @@ instance Show1 AliasAs where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable AliasAs
data InsteadOf a = InsteadOf a a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 InsteadOf where liftEq = genericLiftEq
instance Ord1 InsteadOf where liftCompare = genericLiftCompare
@ -399,7 +399,7 @@ instance Show1 InsteadOf where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable InsteadOf
newtype TraitUseSpecification a = TraitUseSpecification [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TraitUseSpecification where liftEq = genericLiftEq
instance Ord1 TraitUseSpecification where liftCompare = genericLiftCompare
@ -407,7 +407,7 @@ instance Show1 TraitUseSpecification where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable TraitUseSpecification
data TraitUseClause a = TraitUseClause [a] a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 TraitUseClause where liftEq = genericLiftEq
instance Ord1 TraitUseClause where liftCompare = genericLiftCompare
@ -415,7 +415,7 @@ instance Show1 TraitUseClause where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable TraitUseClause
data DestructorDeclaration a = DestructorDeclaration [a] a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 DestructorDeclaration where liftEq = genericLiftEq
instance Ord1 DestructorDeclaration where liftCompare = genericLiftCompare
@ -423,7 +423,7 @@ instance Show1 DestructorDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable DestructorDeclaration
newtype Static a = Static ByteString
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Static where liftEq = genericLiftEq
instance Ord1 Static where liftCompare = genericLiftCompare
@ -431,7 +431,7 @@ instance Show1 Static where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Static
newtype ClassModifier a = ClassModifier ByteString
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ClassModifier where liftEq = genericLiftEq
instance Ord1 ClassModifier where liftCompare = genericLiftCompare
@ -439,7 +439,7 @@ instance Show1 ClassModifier where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ClassModifier
data ConstructorDeclaration a = ConstructorDeclaration [a] [a] a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 ConstructorDeclaration where liftEq = genericLiftEq
instance Ord1 ConstructorDeclaration where liftCompare = genericLiftCompare
@ -447,7 +447,7 @@ instance Show1 ConstructorDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ConstructorDeclaration
data PropertyDeclaration a = PropertyDeclaration a [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 PropertyDeclaration where liftEq = genericLiftEq
instance Ord1 PropertyDeclaration where liftCompare = genericLiftCompare
@ -455,7 +455,7 @@ instance Show1 PropertyDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable PropertyDeclaration
data PropertyModifier a = PropertyModifier a a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 PropertyModifier where liftEq = genericLiftEq
instance Ord1 PropertyModifier where liftCompare = genericLiftCompare
@ -463,7 +463,7 @@ instance Show1 PropertyModifier where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable PropertyModifier
data InterfaceDeclaration a = InterfaceDeclaration a a [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 InterfaceDeclaration where liftEq = genericLiftEq
instance Ord1 InterfaceDeclaration where liftCompare = genericLiftCompare
@ -471,7 +471,7 @@ instance Show1 InterfaceDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable InterfaceDeclaration
newtype InterfaceBaseClause a = InterfaceBaseClause [a]
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 InterfaceBaseClause where liftEq = genericLiftEq
instance Ord1 InterfaceBaseClause where liftCompare = genericLiftCompare
@ -479,7 +479,7 @@ instance Show1 InterfaceBaseClause where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable InterfaceBaseClause
newtype Echo a = Echo a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Echo where liftEq = genericLiftEq
instance Ord1 Echo where liftCompare = genericLiftCompare
@ -487,7 +487,7 @@ instance Show1 Echo where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Echo
newtype Unset a = Unset a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Unset where liftEq = genericLiftEq
instance Ord1 Unset where liftCompare = genericLiftCompare
@ -495,7 +495,7 @@ instance Show1 Unset where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Unset
data Declare a = Declare a a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 Declare where liftEq = genericLiftEq
instance Ord1 Declare where liftCompare = genericLiftCompare
@ -503,7 +503,7 @@ instance Show1 Declare where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Declare
newtype DeclareDirective a = DeclareDirective a
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 DeclareDirective where liftEq = genericLiftEq
instance Ord1 DeclareDirective where liftCompare = genericLiftCompare
@ -511,7 +511,7 @@ instance Show1 DeclareDirective where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable DeclareDirective
newtype LabeledStatement a = LabeledStatement { _labeledStatementIdentifier :: a }
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
instance Eq1 LabeledStatement where liftEq = genericLiftEq
instance Ord1 LabeledStatement where liftCompare = genericLiftCompare

36
src/Language/Python/Assignment.hs
View File

@ -243,16 +243,11 @@ exceptClause = makeTerm <$> symbol ExceptClause <*> children
<*> expressions)
functionDefinition :: Assignment
functionDefinition
= makeFunctionDeclaration <$> symbol FunctionDefinition <*> children ((,,,) <$> term expression <* symbol Parameters <*> children (manyTerm expression) <*> optional (symbol Type *> children (term expression)) <*> expressions)
<|> makeAsyncFunctionDeclaration <$> symbol AsyncFunctionDefinition <*> children ((,,,,) <$> term async' <*> term expression <* symbol Parameters <*> children (manyTerm expression) <*> optional (symbol Type *> children (term expression)) <*> expressions)
functionDefinition =
makeFunctionDeclaration <$> symbol FunctionDefinition <*> children ((,,,) <$> term expression <* symbol Parameters <*> children (manyTerm expression) <*> optional (symbol Type *> children (term expression)) <*> expressions)
<|> makeFunctionDeclaration <$> (symbol Lambda' <|> symbol Lambda) <*> children ((,,,) <$ token AnonLambda <*> emptyTerm <*> (symbol LambdaParameters *> children (manyTerm expression) <|> pure []) <*> optional (symbol Type *> children (term expression)) <*> expressions)
where
makeFunctionDeclaration loc (functionName', functionParameters, ty, functionBody) = makeTerm loc $ Type.Annotation (makeTerm loc $ Declaration.Function [] functionName' functionParameters functionBody) (fromMaybe (makeTerm loc Syntax.Empty) ty)
makeAsyncFunctionDeclaration loc (async', functionName', functionParameters, ty, functionBody) = makeTerm loc $ Type.Annotation (makeTerm loc $ Type.Annotation (makeTerm loc $ Declaration.Function [] functionName' functionParameters functionBody) (fromMaybe (makeTerm loc Syntax.Empty) ty)) async'
async' :: Assignment
async' = makeTerm <$> symbol AnonAsync <*> (Syntax.Identifier . name <$> source)
classDefinition :: Assignment
classDefinition = makeTerm <$> symbol ClassDefinition <*> children (Declaration.Class <$> pure [] <*> term expression <*> argumentList <*> expressions)
@ -297,18 +292,19 @@ unaryOperator = symbol UnaryOperator >>= \ location -> arithmetic location <|> b
binaryOperator :: Assignment
binaryOperator = makeTerm' <$> symbol BinaryOperator <*> children (infixTerm expression (term expression)
[ (inj .) . Expression.Plus <$ symbol AnonPlus
, (inj .) . Expression.Minus <$ symbol AnonMinus
, (inj .) . Expression.Times <$ symbol AnonStar
, (inj .) . Expression.DividedBy <$ symbol AnonSlash
[ (inj .) . Expression.Plus <$ symbol AnonPlus
, (inj .) . Expression.Minus <$ symbol AnonMinus
, (inj .) . Expression.Times <$ symbol AnonStar
, (inj .) . Expression.Times <$ symbol AnonAt -- Matrix multiplication, TODO: May not want to assign to Expression.Times.
, (inj .) . Expression.DividedBy <$ symbol AnonSlash
, (inj .) . Expression.FloorDivision <$ symbol AnonSlashSlash
, (inj .) . Expression.Modulo <$ symbol AnonPercent
, (inj .) . Expression.Power <$ symbol AnonStarStar
, (inj .) . Expression.BOr <$ symbol AnonPipe
, (inj .) . Expression.BAnd <$ symbol AnonAmpersand
, (inj .) . Expression.BXOr <$ symbol AnonCaret
, (inj .) . Expression.LShift <$ symbol AnonLAngleLAngle
, (inj .) . Expression.RShift <$ symbol AnonRAngleRAngle
, (inj .) . Expression.Modulo <$ symbol AnonPercent
, (inj .) . Expression.Power <$ symbol AnonStarStar
, (inj .) . Expression.BOr <$ symbol AnonPipe
, (inj .) . Expression.BAnd <$ symbol AnonAmpersand
, (inj .) . Expression.BXOr <$ symbol AnonCaret
, (inj .) . Expression.LShift <$ symbol AnonLAngleLAngle
, (inj .) . Expression.RShift <$ symbol AnonRAngleRAngle
])
booleanOperator :: Assignment
@ -318,11 +314,12 @@ booleanOperator = makeTerm' <$> symbol BooleanOperator <*> children (infixTerm e
])
assignment' :: Assignment
assignment' = makeTerm <$> symbol Assignment <*> children (Statement.Assignment [] <$> term expressionList <*> term rvalue)
assignment' = makeAssignment <$> symbol Assignment <*> children ((,,) <$> term expressionList <*> optional (symbol Type *> children (term expression)) <*> term rvalue)
<|> makeTerm' <$> symbol AugmentedAssignment <*> children (infixTerm expressionList (term rvalue)
[ assign Expression.Plus <$ symbol AnonPlusEqual
, assign Expression.Minus <$ symbol AnonMinusEqual
, assign Expression.Times <$ symbol AnonStarEqual
, assign Expression.Times <$ symbol AnonAtEqual -- Matrix multiplication assignment. TODO: May not want to assign to Expression.Times.
, assign Expression.Power <$ symbol AnonStarStarEqual
, assign Expression.DividedBy <$ symbol AnonSlashEqual
, assign Expression.DividedBy <$ symbol AnonSlashSlashEqual
@ -334,6 +331,7 @@ assignment' = makeTerm <$> symbol Assignment <*> children (Statement.Assignmen
, assign Expression.BXOr <$ symbol AnonCaretEqual
])
where rvalue = expressionList <|> assignment' <|> yield
makeAssignment loc (lhs, maybeType, rhs) = makeTerm loc (Statement.Assignment (maybeToList maybeType) lhs rhs)
assign :: (f :< Syntax) => (Term -> Term -> f Term) -> Term -> Term -> Union Syntax Term
assign c l r = inj (Statement.Assignment [] l (makeTerm1 (c l r)))

21
src/Language/Python/Syntax.hs
View File

@ -55,11 +55,11 @@ resolvePythonModules :: MonadEvaluatable location term value m => QualifiedName
resolvePythonModules q = do
relRootDir <- rootDir q <$> currentModule
for (moduleNames q) $ \name -> do
x <- trace ("resolving: " <> show name) $ search relRootDir name
trace ("found: " <> show x) (pure x)
x <- search relRootDir name
traceResolve name x $ pure x
where
rootDir (QualifiedName _) ModuleInfo{..} = takeDirectory (makeRelative moduleRoot modulePath)
rootDir (RelativeQualifiedName n _) ModuleInfo{..} = upDir numDots (takeDirectory (makeRelative moduleRoot modulePath))
rootDir (QualifiedName _) ModuleInfo{..} = takeDirectory modulePath
rootDir (RelativeQualifiedName n _) ModuleInfo{..} = upDir numDots (takeDirectory modulePath)
where numDots = pred (length n)
upDir n dir | n <= 0 = dir
| otherwise = takeDirectory (upDir (pred n) dir)
@ -74,8 +74,7 @@ resolvePythonModules q = do
let searchPaths = [ path </> "__init__.py"
, path <.> ".py"
]
trace ("searching in: " <> show searchPaths) $
resolve searchPaths >>= maybeFail (notFound searchPaths)
resolve searchPaths >>= maybeFail (notFound searchPaths)
friendlyName :: QualifiedName -> String
friendlyName (QualifiedName xs) = intercalate "." (NonEmpty.toList xs)
@ -86,7 +85,7 @@ resolvePythonModules q = do
--
-- If the list of symbols is empty copy everything to the calling environment.
data Import a = Import { importFrom :: QualifiedName, importSymbols :: ![(Name, Name)] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Import where liftEq = genericLiftEq
instance Ord1 Import where liftCompare = genericLiftCompare
@ -114,7 +113,7 @@ instance Evaluatable Import where
newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 QualifiedImport where liftEq = genericLiftEq
instance Ord1 QualifiedImport where liftCompare = genericLiftCompare
@ -140,7 +139,7 @@ instance Evaluatable QualifiedImport where
makeNamespace name addr []
data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportFrom :: QualifiedName, qualifiedAliasedImportAlias :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 QualifiedAliasedImport where liftEq = genericLiftEq
instance Ord1 QualifiedAliasedImport where liftCompare = genericLiftCompare
@ -165,7 +164,7 @@ instance Evaluatable QualifiedAliasedImport where
-- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)
data Ellipsis a = Ellipsis
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Ellipsis where liftEq = genericLiftEq
instance Ord1 Ellipsis where liftCompare = genericLiftCompare
@ -176,7 +175,7 @@ instance Evaluatable Ellipsis
data Redirect a = Redirect !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Redirect where liftEq = genericLiftEq
instance Ord1 Redirect where liftCompare = genericLiftCompare

7
src/Language/Ruby/Assignment.hs
View File

@ -201,7 +201,7 @@ literal =
<|> makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
<|> makeTerm <$> symbol ChainedString <*> children (many (makeTerm <$> symbol String <*> (Literal.TextElement <$> source)))
<|> makeTerm <$> symbol Regex <*> (Literal.Regex <$> source)
<|> makeTerm <$> symbol Symbol <*> (Literal.Symbol <$> source)
<|> makeTerm <$> (symbol Symbol <|> symbol Symbol') <*> (Literal.Symbol <$> source)
heredoc :: Assignment
heredoc = makeTerm <$> symbol HeredocBeginning <*> (Literal.TextElement <$> source)
@ -340,7 +340,7 @@ methodCall = makeTerm' <$> symbol MethodCall <*> children (require <|> load <|>
dotCall = symbol Call *> children (Ruby.Syntax.Send <$> (Just <$> term expression) <*> pure Nothing <*> args)
selector = Just <$> term methodSelector
require = inj <$> ((symbol Identifier <|> symbol Identifier') *> do
require = inj <$> (symbol Identifier *> do
s <- source
guard (s `elem` ["require", "require_relative"])
Ruby.Syntax.Require (s == "require_relative") <$> nameExpression)
@ -355,7 +355,6 @@ methodSelector :: Assignment
methodSelector = makeTerm <$> symbols <*> (Syntax.Identifier <$> (name <$> source))
where
symbols = symbol Identifier
<|> symbol Identifier'
<|> symbol Constant
<|> symbol Operator
<|> symbol Setter
@ -410,7 +409,7 @@ assignment' = makeTerm <$> symbol Assignment <*> children (Statement.As
identWithLocals :: Assignment' (Record Location, ByteString, [ByteString])
identWithLocals = do
loc <- symbol Identifier <|> symbol Identifier'
loc <- symbol Identifier
-- source advances, so it's important we call getRubyLocals first
locals <- getRubyLocals
ident <- source

20
src/Language/Ruby/Syntax.hs
View File

@ -29,15 +29,11 @@ resolveRubyPath path = do
modulePath <- resolve [name']
maybe (throwException @(ResolutionError value) $ RubyError name') pure modulePath
maybeFailNotFound :: MonadFail m => String -> Maybe a -> m a
maybeFailNotFound name = maybeFail notFound
where notFound = "Unable to resolve: " <> name
cleanNameOrPath :: ByteString -> String
cleanNameOrPath = BC.unpack . dropRelativePrefix . stripQuotes
data Send a = Send { sendReceiver :: Maybe a, sendSelector :: Maybe a, sendArgs :: [a], sendBlock :: Maybe a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Send where liftEq = genericLiftEq
instance Ord1 Send where liftCompare = genericLiftCompare
@ -58,7 +54,7 @@ instance Evaluatable Send where
call func (map subtermValue sendArgs) -- TODO pass through sendBlock
data Require a = Require { requireRelative :: Bool, requirePath :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Require where liftEq = genericLiftEq
instance Ord1 Require where liftCompare = genericLiftCompare
@ -68,7 +64,7 @@ instance Evaluatable Require where
eval (Require _ x) = do
name <- subtermValue x >>= asString
path <- resolveRubyName name
(importedEnv, v) <- isolate (doRequire path)
(importedEnv, v) <- traceResolve name path $ isolate (doRequire path)
modifyEnv (`mergeNewer` importedEnv)
pure v -- Returns True if the file was loaded, False if it was already loaded. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-require
@ -83,7 +79,7 @@ doRequire name = do
newtype Load a = Load { loadArgs :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Load where liftEq = genericLiftEq
instance Ord1 Load where liftCompare = genericLiftCompare
@ -102,14 +98,14 @@ instance Evaluatable Load where
doLoad :: MonadEvaluatable location term value m => ByteString -> Bool -> m value
doLoad path shouldWrap = do
path' <- resolveRubyPath path
(importedEnv, _) <- isolate (load path')
(importedEnv, _) <- traceResolve path path' $ isolate (load path')
unless shouldWrap $ modifyEnv (mappend importedEnv)
boolean Prelude.True -- load always returns true. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-load
-- TODO: autoload
data Class a = Class { classIdentifier :: !a, classSuperClasses :: ![a], classBody :: !a }
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Diffable Class where
equivalentBySubterm = Just . classIdentifier
@ -126,7 +122,7 @@ instance Evaluatable Class where
subtermValue classBody <* makeNamespace name addr supers
data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Module where liftEq = genericLiftEq
instance Ord1 Module where liftCompare = genericLiftCompare
@ -141,7 +137,7 @@ instance Evaluatable Module where
data LowPrecedenceBoolean a
= LowAnd !a !a
| LowOr !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Evaluatable LowPrecedenceBoolean where
-- N.B. we have to use Monad rather than Applicative/Traversable on 'And' and 'Or' so that we don't evaluate both operands

22
src/Language/TypeScript/Assignment.hs
View File

@ -66,6 +66,7 @@ type Syntax = '[
, Statement.Break
, Statement.Catch
, Statement.Continue
, Statement.DoWhile
, Statement.Else
, Statement.Finally
, Statement.For
@ -78,11 +79,10 @@ type Syntax = '[
, Statement.Return
, Statement.ScopeEntry
, Statement.ScopeExit
, Statement.Throw
, Statement.Try
, Statement.While
, Statement.Yield
, Statement.Throw
, Statement.DoWhile
, Syntax.AccessibilityModifier
, Syntax.Empty
, Syntax.Error
@ -166,6 +166,7 @@ type Syntax = '[
, TypeScript.Syntax.DefaultExport
, TypeScript.Syntax.QualifiedExport
, TypeScript.Syntax.QualifiedExportFrom
, TypeScript.Syntax.JavaScriptRequire
, []
]
@ -482,8 +483,9 @@ function :: Assignment
function = makeFunction <$> (symbol Grammar.Function <|> symbol Grammar.GeneratorFunction) <*> children ((,,) <$> term (identifier <|> emptyTerm) <*> callSignatureParts <*> term statementBlock)
where makeFunction loc (id, (typeParams, params, annotation), statements) = makeTerm loc (Declaration.Function [typeParams, annotation] id params statements)
-- TODO: FunctionSignatures can, but don't have to be ambient functions.
ambientFunction :: Assignment
ambientFunction = makeAmbientFunction <$> symbol Grammar.AmbientFunction <*> children ((,) <$> term identifier <*> callSignatureParts)
ambientFunction = makeAmbientFunction <$> symbol Grammar.FunctionSignature <*> children ((,) <$> term identifier <*> callSignatureParts)
where makeAmbientFunction loc (id, (typeParams, params, annotation)) = makeTerm loc (TypeScript.Syntax.AmbientFunction [typeParams, annotation] id params)
ty :: Assignment
@ -785,8 +787,18 @@ variableDeclaration :: Assignment
variableDeclaration = makeTerm <$> (symbol Grammar.VariableDeclaration <|> symbol Grammar.LexicalDeclaration) <*> children (Declaration.VariableDeclaration <$> manyTerm variableDeclarator)
variableDeclarator :: Assignment
variableDeclarator = makeVarDecl <$> symbol VariableDeclarator <*> children ((,,) <$> term (identifier <|> destructuringPattern) <*> (term typeAnnotation' <|> emptyTerm) <*> (term expression <|> emptyTerm))
where makeVarDecl loc (subject, annotations, value) = makeTerm loc (Statement.Assignment [annotations] subject value)
variableDeclarator =
makeTerm <$> symbol VariableDeclarator <*> children (TypeScript.Syntax.JavaScriptRequire <$> identifier <*> requireCall)
<|> makeVarDecl <$> symbol VariableDeclarator <*> children ((,,) <$> term (identifier <|> destructuringPattern) <*> (term typeAnnotation' <|> emptyTerm) <*> (term expression <|> emptyTerm))
where
makeVarDecl loc (subject, annotations, value) = makeTerm loc (Statement.Assignment [annotations] subject value)
requireCall = symbol CallExpression *> children ((symbol Identifier <|> symbol Identifier') *> do
s <- source
guard (s == "require")
symbol Arguments *> children (symbol Grammar.String *> (TypeScript.Syntax.importPath <$> source))
)
parenthesizedExpression :: Assignment
parenthesizedExpression = makeTerm <$> symbol ParenthesizedExpression <*> (Syntax.Paren <$> children (term expressions))

272
src/Language/TypeScript/Syntax.hs
View File

@ -1,14 +1,15 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveAnyClass, ScopedTypeVariables #-}
module Language.TypeScript.Syntax where
import qualified Data.Abstract.Environment as Env
import qualified Data.Abstract.FreeVariables as FV
import Data.Abstract.Evaluatable
import Data.Abstract.Path
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString as B
import Data.Abstract.Module (ModulePath, ModuleInfo(..))
import Diffing.Algorithm
import Prelude hiding (fail)
import Prelude
import Prologue
import System.FilePath.Posix
@ -28,9 +29,11 @@ importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (path
toName :: ImportPath -> Name
toName = FV.name . BC.pack . unPath
resolveTypeScriptModule :: MonadEvaluatable location term value m => ImportPath -> m ModulePath
resolveTypeScriptModule (ImportPath path Relative) = resolveRelativeTSModule path
resolveTypeScriptModule (ImportPath path NonRelative) = resolveNonRelativeTSModule path
-- Node.js resolution algorithm: https://nodejs.org/api/modules.html#modules_all_together
-- TypeScript has a couple of different strategies, but the main one mimics Node.js.
resolveWithNodejsStrategy :: forall value term location m. MonadEvaluatable location term value m => ImportPath -> [String] -> m ModulePath
resolveWithNodejsStrategy (ImportPath path Relative) exts = resolveRelativePath path exts
resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativePath path exts
-- | Resolve a relative TypeScript import to a known 'ModuleName' or fail.
--
@ -39,14 +42,14 @@ resolveTypeScriptModule (ImportPath path NonRelative) = resolveNonRelativeTSModu
-- /root/src/moduleB.ts
-- /root/src/moduleB/package.json (if it specifies a "types" property)
-- /root/src/moduleB/index.ts
resolveRelativeTSModule :: MonadEvaluatable location term value m => FilePath -> m ModulePath
resolveRelativeTSModule relImportPath = do
resolveRelativePath :: forall value term location m. MonadEvaluatable location term value m => FilePath -> [String] -> m ModulePath
resolveRelativePath relImportPath exts = do
ModuleInfo{..} <- currentModule
let relRootDir = takeDirectory (makeRelative moduleRoot modulePath)
let path = normalise (relRootDir </> normalise relImportPath)
resolveTSModule path >>= either notFound pure
let relRootDir = takeDirectory modulePath
let path = joinPaths relRootDir relImportPath
resolveTSModule path exts >>= either notFound (\x -> traceResolve relImportPath x (pure x))
where
notFound xs = fail $ "Unable to resolve relative module import: " <> show relImportPath <> ", looked for it in: " <> show xs
notFound _ = throwException @(ResolutionError value) $ TypeScriptError relImportPath
-- | Resolve a non-relative TypeScript import to a known 'ModuleName' or fail.
--
@ -58,34 +61,45 @@ resolveRelativeTSModule relImportPath = do
--
-- /root/node_modules/moduleB.ts, etc
-- /node_modules/moduleB.ts, etc
resolveNonRelativeTSModule :: MonadEvaluatable location term value m => FilePath -> m ModulePath
resolveNonRelativeTSModule name = do
resolveNonRelativePath :: forall value term location m. MonadEvaluatable location term value m => FilePath -> [String] -> m ModulePath
resolveNonRelativePath name exts = do
ModuleInfo{..} <- currentModule
go "." (makeRelative moduleRoot modulePath) mempty
go "." modulePath mempty
where
nodeModulesPath dir = takeDirectory dir </> "node_modules" </> name
-- Recursively search in a 'node_modules' directory, stepping up a directory each time.
go root path searched = do
res <- resolveTSModule (nodeModulesPath path)
res <- resolveTSModule (nodeModulesPath path) exts
case res of
Left xs | parentDir <- takeDirectory path , root /= parentDir -> go root parentDir (searched <> xs)
| otherwise -> notFound (searched <> xs)
Right m -> pure m
notFound xs = fail $ "Unable to resolve non-relative module import: " <> show name <> ", looked for it in: " <> show xs
Right m -> traceResolve name m $ pure m
notFound _ = throwException @(ResolutionError value) $ TypeScriptError name
resolveTSModule :: MonadEvaluatable location term value m => FilePath -> m (Either [FilePath] ModulePath)
resolveTSModule path = maybe (Left searchPaths) Right <$> resolve searchPaths
where exts = ["ts", "tsx", "d.ts"]
searchPaths =
resolveTSModule :: MonadEvaluatable location term value m => FilePath -> [String] -> m (Either [FilePath] ModulePath)
resolveTSModule path exts = maybe (Left searchPaths) Right <$> resolve searchPaths
where searchPaths =
((path <.>) <$> exts)
-- TODO: Requires parsing package.json, getting the path of the
-- "types" property and adding that value to the search Paths.
-- <> [searchDir </> "package.json"]
<> (((path </> "index") <.>) <$> exts)
typescriptExtensions :: [String]
typescriptExtensions = ["ts", "tsx", "d.ts"]
javascriptExtensions :: [String]
javascriptExtensions = ["js"]
evalRequire :: MonadEvaluatable location term value m => ModulePath -> Name -> m value
evalRequire modulePath alias = letrec' alias $ \addr -> do
(importedEnv, _) <- isolate (require modulePath)
modifyEnv (mappend importedEnv)
void $ makeNamespace alias addr []
unit
data Import a = Import { importSymbols :: ![(Name, Name)], importFrom :: ImportPath }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Import where liftEq = genericLiftEq
instance Ord1 Import where liftCompare = genericLiftCompare
@ -94,7 +108,7 @@ instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
-- http://www.typescriptlang.org/docs/handbook/module-resolution.html
instance Evaluatable Import where
eval (Import symbols importPath) = do
modulePath <- resolveTypeScriptModule importPath
modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
(importedEnv, _) <- isolate (require modulePath)
modifyEnv (mappend (renamed importedEnv)) *> unit
where
@ -102,25 +116,35 @@ instance Evaluatable Import where
| Prologue.null symbols = importedEnv
| otherwise = Env.overwrite symbols importedEnv
data JavaScriptRequire a = JavaScriptRequire { javascriptRequireIden :: !a, javascriptRequireFrom :: ImportPath }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 JavaScriptRequire where liftEq = genericLiftEq
instance Ord1 JavaScriptRequire where liftCompare = genericLiftCompare
instance Show1 JavaScriptRequire where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable JavaScriptRequire where
eval (JavaScriptRequire aliasTerm importPath) = do
modulePath <- resolveWithNodejsStrategy importPath javascriptExtensions
alias <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm aliasTerm)
evalRequire modulePath alias
data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportAlias :: !a, qualifiedAliasedImportFrom :: ImportPath }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 QualifiedAliasedImport where liftEq = genericLiftEq
instance Ord1 QualifiedAliasedImport where liftCompare = genericLiftCompare
instance Show1 QualifiedAliasedImport where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable QualifiedAliasedImport where
eval (QualifiedAliasedImport aliasTerm importPath ) = do
modulePath <- resolveTypeScriptModule importPath
eval (QualifiedAliasedImport aliasTerm importPath) = do
modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
alias <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm aliasTerm)
letrec' alias $ \addr -> do
(importedEnv, _) <- isolate (require modulePath)
modifyEnv (mappend importedEnv)
void $ makeNamespace alias addr []
unit
evalRequire modulePath alias
newtype SideEffectImport a = SideEffectImport { sideEffectImportFrom :: ImportPath }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 SideEffectImport where liftEq = genericLiftEq
instance Ord1 SideEffectImport where liftCompare = genericLiftCompare
@ -128,14 +152,14 @@ instance Show1 SideEffectImport where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable SideEffectImport where
eval (SideEffectImport importPath) = do
modulePath <- resolveTypeScriptModule importPath
modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
void $ isolate (require modulePath)
unit
-- | Qualified Export declarations
newtype QualifiedExport a = QualifiedExport { qualifiedExportSymbols :: [(Name, Name)] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 QualifiedExport where liftEq = genericLiftEq
instance Ord1 QualifiedExport where liftCompare = genericLiftCompare
@ -151,7 +175,7 @@ instance Evaluatable QualifiedExport where
-- | Qualified Export declarations that export from another module.
data QualifiedExportFrom a = QualifiedExportFrom { qualifiedExportFrom :: ImportPath, qualifiedExportFromSymbols :: ![(Name, Name)]}
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 QualifiedExportFrom where liftEq = genericLiftEq
instance Ord1 QualifiedExportFrom where liftCompare = genericLiftCompare
@ -159,31 +183,37 @@ instance Show1 QualifiedExportFrom where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable QualifiedExportFrom where
eval (QualifiedExportFrom importPath exportSymbols) = do
modulePath <- resolveTypeScriptModule importPath
modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
(importedEnv, _) <- isolate (require modulePath)
-- Look up addresses in importedEnv and insert the aliases with addresses into the exports.
for_ exportSymbols $ \(name, alias) -> do
let address = Env.lookup name importedEnv
maybe (cannotExport modulePath name) (addExport name alias . Just) address
maybe (throwEvalError $ ExportError modulePath name) (addExport name alias . Just) address
unit
where
cannotExport moduleName name = fail $
"module " <> show moduleName <> " does not export " <> show (unName name)
newtype DefaultExport a = DefaultExport { defaultExport :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 DefaultExport where liftEq = genericLiftEq
instance Ord1 DefaultExport where liftCompare = genericLiftCompare
instance Show1 DefaultExport where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable DefaultExport where
eval (DefaultExport term) = do
v <- subtermValue term
case declaredName term of
Just name -> do
addr <- lookupOrAlloc name
assign addr v
addExport name name Nothing
void $ modifyEnv (Env.insert name addr)
Nothing -> throwEvalError DefaultExportError
unit
-- | Lookup type for a type-level key in a typescript map.
data LookupType a = LookupType { lookupTypeIdentifier :: a, lookupTypeKey :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 LookupType where liftEq = genericLiftEq
instance Ord1 LookupType where liftCompare = genericLiftCompare
@ -192,7 +222,7 @@ instance Evaluatable LookupType
-- | ShorthandPropertyIdentifier used in object patterns such as var baz = { foo } to mean var baz = { foo: foo }
newtype ShorthandPropertyIdentifier a = ShorthandPropertyIdentifier ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ShorthandPropertyIdentifier where liftEq = genericLiftEq
instance Ord1 ShorthandPropertyIdentifier where liftCompare = genericLiftCompare
@ -200,7 +230,7 @@ instance Show1 ShorthandPropertyIdentifier where liftShowsPrec = genericLiftShow
instance Evaluatable ShorthandPropertyIdentifier
data Union a = Union { _unionLeft :: !a, _unionRight :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Language.TypeScript.Syntax.Union where liftEq = genericLiftEq
instance Ord1 Language.TypeScript.Syntax.Union where liftCompare = genericLiftCompare
@ -208,7 +238,7 @@ instance Show1 Language.TypeScript.Syntax.Union where liftShowsPrec = genericLif
instance Evaluatable Language.TypeScript.Syntax.Union
data Intersection a = Intersection { _intersectionLeft :: !a, _intersectionRight :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Intersection where liftEq = genericLiftEq
instance Ord1 Intersection where liftCompare = genericLiftCompare
@ -216,7 +246,7 @@ instance Show1 Intersection where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Intersection
data FunctionType a = FunctionType { _functionTypeParameters :: !a, _functionFormalParameters :: ![a], _functionType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 FunctionType where liftEq = genericLiftEq
instance Ord1 FunctionType where liftCompare = genericLiftCompare
@ -224,7 +254,7 @@ instance Show1 FunctionType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable FunctionType
data AmbientFunction a = AmbientFunction { _ambientFunctionContext :: ![a], _ambientFunctionIdentifier :: !a, _ambientFunctionParameters :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 AmbientFunction where liftEq = genericLiftEq
instance Ord1 AmbientFunction where liftCompare = genericLiftCompare
@ -232,7 +262,7 @@ instance Show1 AmbientFunction where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable AmbientFunction
data ImportRequireClause a = ImportRequireClause { _importRequireIdentifier :: !a, _importRequireSubject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ImportRequireClause where liftEq = genericLiftEq
instance Ord1 ImportRequireClause where liftCompare = genericLiftCompare
@ -240,7 +270,7 @@ instance Show1 ImportRequireClause where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ImportRequireClause
newtype ImportClause a = ImportClause { _importClauseElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ImportClause where liftEq = genericLiftEq
instance Ord1 ImportClause where liftCompare = genericLiftCompare
@ -248,7 +278,7 @@ instance Show1 ImportClause where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ImportClause
newtype Tuple a = Tuple { _tupleElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Tuple where liftEq = genericLiftEq
instance Ord1 Tuple where liftCompare = genericLiftCompare
@ -258,7 +288,7 @@ instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Tuple
data Constructor a = Constructor { _constructorTypeParameters :: !a, _constructorFormalParameters :: ![a], _constructorType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Language.TypeScript.Syntax.Constructor where liftEq = genericLiftEq
instance Ord1 Language.TypeScript.Syntax.Constructor where liftCompare = genericLiftCompare
@ -266,7 +296,7 @@ instance Show1 Language.TypeScript.Syntax.Constructor where liftShowsPrec = gene
instance Evaluatable Language.TypeScript.Syntax.Constructor
data TypeParameter a = TypeParameter { _typeParameter :: !a, _typeParameterConstraint :: !a, _typeParameterDefaultType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 TypeParameter where liftEq = genericLiftEq
instance Ord1 TypeParameter where liftCompare = genericLiftCompare
@ -274,7 +304,7 @@ instance Show1 TypeParameter where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable TypeParameter
data TypeAssertion a = TypeAssertion { _typeAssertionParameters :: !a, _typeAssertionExpression :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 TypeAssertion where liftEq = genericLiftEq
instance Ord1 TypeAssertion where liftCompare = genericLiftCompare
@ -282,7 +312,7 @@ instance Show1 TypeAssertion where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable TypeAssertion
newtype Annotation a = Annotation { _annotationType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Annotation where liftEq = genericLiftEq
instance Ord1 Annotation where liftCompare = genericLiftCompare
@ -290,7 +320,7 @@ instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Annotation
newtype Decorator a = Decorator { _decoratorTerm :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Decorator where liftEq = genericLiftEq
instance Ord1 Decorator where liftCompare = genericLiftCompare
@ -298,7 +328,7 @@ instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Decorator
newtype ComputedPropertyName a = ComputedPropertyName a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ComputedPropertyName where liftEq = genericLiftEq
instance Ord1 ComputedPropertyName where liftCompare = genericLiftCompare
@ -306,7 +336,7 @@ instance Show1 ComputedPropertyName where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ComputedPropertyName
newtype Constraint a = Constraint { _constraintType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Constraint where liftEq = genericLiftEq
instance Ord1 Constraint where liftCompare = genericLiftCompare
@ -314,7 +344,7 @@ instance Show1 Constraint where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Constraint
newtype DefaultType a = DefaultType { _defaultType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 DefaultType where liftEq = genericLiftEq
instance Ord1 DefaultType where liftCompare = genericLiftCompare
@ -322,7 +352,7 @@ instance Show1 DefaultType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable DefaultType
newtype ParenthesizedType a = ParenthesizedType { _parenthesizedType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ParenthesizedType where liftEq = genericLiftEq
instance Ord1 ParenthesizedType where liftCompare = genericLiftCompare
@ -330,7 +360,7 @@ instance Show1 ParenthesizedType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ParenthesizedType
newtype PredefinedType a = PredefinedType { _predefinedType :: ByteString }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 PredefinedType where liftEq = genericLiftEq
instance Ord1 PredefinedType where liftCompare = genericLiftCompare
@ -338,7 +368,7 @@ instance Show1 PredefinedType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable PredefinedType
newtype TypeIdentifier a = TypeIdentifier ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 TypeIdentifier where liftEq = genericLiftEq
instance Ord1 TypeIdentifier where liftCompare = genericLiftCompare
@ -346,7 +376,7 @@ instance Show1 TypeIdentifier where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable TypeIdentifier
data NestedIdentifier a = NestedIdentifier !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 NestedIdentifier where liftEq = genericLiftEq
instance Ord1 NestedIdentifier where liftCompare = genericLiftCompare
@ -354,7 +384,7 @@ instance Show1 NestedIdentifier where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable NestedIdentifier
data NestedTypeIdentifier a = NestedTypeIdentifier !a !a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 NestedTypeIdentifier where liftEq = genericLiftEq
instance Ord1 NestedTypeIdentifier where liftCompare = genericLiftCompare
@ -362,7 +392,7 @@ instance Show1 NestedTypeIdentifier where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable NestedTypeIdentifier
data GenericType a = GenericType { _genericTypeIdentifier :: !a, _genericTypeArguments :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 GenericType where liftEq = genericLiftEq
instance Ord1 GenericType where liftCompare = genericLiftCompare
@ -370,7 +400,7 @@ instance Show1 GenericType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable GenericType
data TypePredicate a = TypePredicate { _typePredicateIdentifier :: !a, _typePredicateType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 TypePredicate where liftEq = genericLiftEq
instance Ord1 TypePredicate where liftCompare = genericLiftCompare
@ -378,7 +408,7 @@ instance Show1 TypePredicate where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable TypePredicate
newtype ObjectType a = ObjectType { _objectTypeElements :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ObjectType where liftEq = genericLiftEq
instance Ord1 ObjectType where liftCompare = genericLiftCompare
@ -386,7 +416,7 @@ instance Show1 ObjectType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ObjectType
data With a = With { _withExpression :: !a, _withBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 With where liftEq = genericLiftEq
instance Ord1 With where liftCompare = genericLiftCompare
@ -394,7 +424,7 @@ instance Show1 With where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable With
newtype AmbientDeclaration a = AmbientDeclaration { _ambientDeclarationBody :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 AmbientDeclaration where liftEq = genericLiftEq
instance Ord1 AmbientDeclaration where liftCompare = genericLiftCompare
@ -403,16 +433,19 @@ instance Show1 AmbientDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable AmbientDeclaration where
eval (AmbientDeclaration body) = subtermValue body
data EnumDeclaration a = EnumDeclaration { _enumDeclarationIdentifier :: !a, _enumDeclarationBody :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
data EnumDeclaration a = EnumDeclaration { enumDeclarationIdentifier :: !a, _enumDeclarationBody :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 EnumDeclaration where liftEq = genericLiftEq
instance Ord1 EnumDeclaration where liftCompare = genericLiftCompare
instance Show1 EnumDeclaration where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable EnumDeclaration
instance Declarations a => Declarations (EnumDeclaration a) where
declaredName EnumDeclaration{..} = declaredName enumDeclarationIdentifier
newtype ExtendsClause a = ExtendsClause { _extendsClauses :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ExtendsClause where liftEq = genericLiftEq
instance Ord1 ExtendsClause where liftCompare = genericLiftCompare
@ -420,7 +453,7 @@ instance Show1 ExtendsClause where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ExtendsClause
newtype ArrayType a = ArrayType { _arrayType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ArrayType where liftEq = genericLiftEq
instance Ord1 ArrayType where liftCompare = genericLiftCompare
@ -428,7 +461,7 @@ instance Show1 ArrayType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ArrayType
newtype FlowMaybeType a = FlowMaybeType { _flowMaybeType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 FlowMaybeType where liftEq = genericLiftEq
instance Ord1 FlowMaybeType where liftCompare = genericLiftCompare
@ -436,7 +469,7 @@ instance Show1 FlowMaybeType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable FlowMaybeType
newtype TypeQuery a = TypeQuery { _typeQuerySubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 TypeQuery where liftEq = genericLiftEq
instance Ord1 TypeQuery where liftCompare = genericLiftCompare
@ -444,7 +477,7 @@ instance Show1 TypeQuery where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable TypeQuery
newtype IndexTypeQuery a = IndexTypeQuery { _indexTypeQuerySubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 IndexTypeQuery where liftEq = genericLiftEq
instance Ord1 IndexTypeQuery where liftCompare = genericLiftCompare
@ -452,7 +485,7 @@ instance Show1 IndexTypeQuery where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable IndexTypeQuery
newtype TypeArguments a = TypeArguments { _typeArguments :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 TypeArguments where liftEq = genericLiftEq
instance Ord1 TypeArguments where liftCompare = genericLiftCompare
@ -460,7 +493,7 @@ instance Show1 TypeArguments where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable TypeArguments
newtype ThisType a = ThisType ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ThisType where liftEq = genericLiftEq
instance Ord1 ThisType where liftCompare = genericLiftCompare
@ -468,7 +501,7 @@ instance Show1 ThisType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ThisType
newtype ExistentialType a = ExistentialType ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ExistentialType where liftEq = genericLiftEq
instance Ord1 ExistentialType where liftCompare = genericLiftCompare
@ -476,7 +509,7 @@ instance Show1 ExistentialType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ExistentialType
newtype LiteralType a = LiteralType { _literalTypeSubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 LiteralType where liftEq = genericLiftEq
instance Ord1 LiteralType where liftCompare = genericLiftCompare
@ -484,7 +517,7 @@ instance Show1 LiteralType where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable LiteralType
data PropertySignature a = PropertySignature { _modifiers :: ![a], _propertySignaturePropertyName :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 PropertySignature where liftEq = genericLiftEq
instance Ord1 PropertySignature where liftCompare = genericLiftCompare
@ -492,7 +525,7 @@ instance Show1 PropertySignature where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable PropertySignature
data CallSignature a = CallSignature { _callSignatureTypeParameters :: !a, _callSignatureParameters :: ![a], _callSignatureType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 CallSignature where liftEq = genericLiftEq
instance Ord1 CallSignature where liftCompare = genericLiftCompare
@ -501,7 +534,7 @@ instance Evaluatable CallSignature
-- | Todo: Move type params and type to context
data ConstructSignature a = ConstructSignature { _constructSignatureTypeParameters :: !a, _constructSignatureParameters :: ![a], _constructSignatureType :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ConstructSignature where liftEq = genericLiftEq
instance Ord1 ConstructSignature where liftCompare = genericLiftCompare
@ -509,7 +542,7 @@ instance Show1 ConstructSignature where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ConstructSignature
data IndexSignature a = IndexSignature { _indexSignatureSubject :: a, _indexSignatureType :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 IndexSignature where liftEq = genericLiftEq
instance Ord1 IndexSignature where liftCompare = genericLiftCompare
@ -517,7 +550,7 @@ instance Show1 IndexSignature where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable IndexSignature
data AbstractMethodSignature a = AbstractMethodSignature { _abstractMethodSignatureContext :: ![a], _abstractMethodSignatureName :: !a, _abstractMethodSignatureParameters :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 AbstractMethodSignature where liftEq = genericLiftEq
instance Ord1 AbstractMethodSignature where liftCompare = genericLiftCompare
@ -525,7 +558,7 @@ instance Show1 AbstractMethodSignature where liftShowsPrec = genericLiftShowsPre
instance Evaluatable AbstractMethodSignature
data Debugger a = Debugger
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Debugger where liftEq = genericLiftEq
instance Ord1 Debugger where liftCompare = genericLiftCompare
@ -533,7 +566,7 @@ instance Show1 Debugger where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Debugger
data ForOf a = ForOf { _forOfBinding :: !a, _forOfSubject :: !a, _forOfBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ForOf where liftEq = genericLiftEq
instance Ord1 ForOf where liftCompare = genericLiftCompare
@ -541,7 +574,7 @@ instance Show1 ForOf where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ForOf
data This a = This
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 This where liftEq = genericLiftEq
instance Ord1 This where liftCompare = genericLiftCompare
@ -549,7 +582,7 @@ instance Show1 This where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable This
data LabeledStatement a = LabeledStatement { _labeledStatementIdentifier :: !a, _labeledStatementSubject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 LabeledStatement where liftEq = genericLiftEq
instance Ord1 LabeledStatement where liftCompare = genericLiftCompare
@ -557,7 +590,7 @@ instance Show1 LabeledStatement where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable LabeledStatement
newtype Update a = Update { _updateSubject :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Update where liftEq = genericLiftEq
instance Ord1 Update where liftCompare = genericLiftCompare
@ -565,7 +598,7 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Update
data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Module where liftEq = genericLiftEq
instance Ord1 Module where liftCompare = genericLiftCompare
@ -580,7 +613,7 @@ instance Evaluatable Module where
data InternalModule a = InternalModule { internalModuleIdentifier :: !a, internalModuleStatements :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 InternalModule where liftEq = genericLiftEq
instance Ord1 InternalModule where liftCompare = genericLiftCompare
@ -592,9 +625,12 @@ instance Evaluatable InternalModule where
letrec' name $ \addr ->
eval xs <* makeNamespace name addr []
instance Declarations a => Declarations (InternalModule a) where
declaredName InternalModule{..} = declaredName internalModuleIdentifier
data ImportAlias a = ImportAlias { _importAliasSubject :: !a, _importAlias :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ImportAlias where liftEq = genericLiftEq
instance Ord1 ImportAlias where liftCompare = genericLiftCompare
@ -602,7 +638,7 @@ instance Show1 ImportAlias where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ImportAlias
data Super a = Super
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Super where liftEq = genericLiftEq
instance Ord1 Super where liftCompare = genericLiftCompare
@ -610,7 +646,7 @@ instance Show1 Super where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Super
data Undefined a = Undefined
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 Undefined where liftEq = genericLiftEq
instance Ord1 Undefined where liftCompare = genericLiftCompare
@ -618,23 +654,35 @@ instance Show1 Undefined where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Undefined
data ClassHeritage a = ClassHeritage { _classHeritageExtendsClause :: !a, _implementsClause :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ClassHeritage where liftEq = genericLiftEq
instance Ord1 ClassHeritage where liftCompare = genericLiftCompare
instance Show1 ClassHeritage where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ClassHeritage
data AbstractClass a = AbstractClass { _abstractClassIdentifier :: !a, _abstractClassTypeParameters :: !a, _classHeritage :: ![a], _classBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
data AbstractClass a = AbstractClass { abstractClassIdentifier :: !a, _abstractClassTypeParameters :: !a, classHeritage :: ![a], classBody :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 AbstractClass where liftEq = genericLiftEq
instance Ord1 AbstractClass where liftCompare = genericLiftCompare
instance Show1 AbstractClass where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable AbstractClass
instance Declarations a => Declarations (AbstractClass a) where
declaredName AbstractClass{..} = declaredName abstractClassIdentifier
instance Evaluatable AbstractClass where
eval AbstractClass{..} = do
name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm abstractClassIdentifier)
supers <- traverse subtermValue classHeritage
(v, addr) <- letrec name $ do
void $ subtermValue classBody
classEnv <- Env.head <$> getEnv
klass name supers classEnv
v <$ modifyEnv (Env.insert name addr)
data JsxElement a = JsxElement { _jsxOpeningElement :: !a, _jsxElements :: ![a], _jsxClosingElement :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 JsxElement where liftEq = genericLiftEq
instance Ord1 JsxElement where liftCompare = genericLiftCompare
@ -642,7 +690,7 @@ instance Show1 JsxElement where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable JsxElement
newtype JsxText a = JsxText ByteString
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 JsxText where liftEq = genericLiftEq
instance Ord1 JsxText where liftCompare = genericLiftCompare
@ -650,7 +698,7 @@ instance Show1 JsxText where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable JsxText
newtype JsxExpression a = JsxExpression { _jsxExpression :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 JsxExpression where liftEq = genericLiftEq
instance Ord1 JsxExpression where liftCompare = genericLiftCompare
@ -658,7 +706,7 @@ instance Show1 JsxExpression where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable JsxExpression
data JsxOpeningElement a = JsxOpeningElement { _jsxOpeningElementIdentifier :: !a, _jsxAttributes :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 JsxOpeningElement where liftEq = genericLiftEq
instance Ord1 JsxOpeningElement where liftCompare = genericLiftCompare
@ -666,7 +714,7 @@ instance Show1 JsxOpeningElement where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable JsxOpeningElement
newtype JsxClosingElement a = JsxClosingElement { _jsxClosingElementIdentifier :: a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 JsxClosingElement where liftEq = genericLiftEq
instance Ord1 JsxClosingElement where liftCompare = genericLiftCompare
@ -674,7 +722,7 @@ instance Show1 JsxClosingElement where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable JsxClosingElement
data JsxSelfClosingElement a = JsxSelfClosingElement { _jsxSelfClosingElementIdentifier :: !a, _jsxSelfClosingElementAttributes :: ![a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 JsxSelfClosingElement where liftEq = genericLiftEq
instance Ord1 JsxSelfClosingElement where liftCompare = genericLiftCompare
@ -682,7 +730,7 @@ instance Show1 JsxSelfClosingElement where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable JsxSelfClosingElement
data JsxAttribute a = JsxAttribute { _jsxAttributeTarget :: !a, _jsxAttributeValue :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 JsxAttribute where liftEq = genericLiftEq
instance Ord1 JsxAttribute where liftCompare = genericLiftCompare
@ -690,7 +738,7 @@ instance Show1 JsxAttribute where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable JsxAttribute
newtype ImplementsClause a = ImplementsClause { _implementsClauseTypes :: [a] }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 ImplementsClause where liftEq = genericLiftEq
instance Ord1 ImplementsClause where liftCompare = genericLiftCompare
@ -698,7 +746,7 @@ instance Show1 ImplementsClause where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ImplementsClause
data OptionalParameter a = OptionalParameter { _optionalParameterContext :: ![a], _optionalParameterSubject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 OptionalParameter where liftEq = genericLiftEq
instance Ord1 OptionalParameter where liftCompare = genericLiftCompare
@ -706,7 +754,7 @@ instance Show1 OptionalParameter where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable OptionalParameter
data RequiredParameter a = RequiredParameter { _requiredParameterContext :: ![a], _requiredParameterSubject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 RequiredParameter where liftEq = genericLiftEq
instance Ord1 RequiredParameter where liftCompare = genericLiftCompare
@ -714,7 +762,7 @@ instance Show1 RequiredParameter where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable RequiredParameter
data RestParameter a = RestParameter { _restParameterContext :: ![a], _restParameterSubject :: !a }
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 RestParameter where liftEq = genericLiftEq
instance Ord1 RestParameter where liftCompare = genericLiftCompare
@ -722,7 +770,7 @@ instance Show1 RestParameter where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable RestParameter
newtype JsxFragment a = JsxFragment [a]
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 JsxFragment where liftEq = genericLiftEq
instance Ord1 JsxFragment where liftCompare = genericLiftCompare
@ -730,7 +778,7 @@ instance Show1 JsxFragment where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable JsxFragment
data JsxNamespaceName a = JsxNamespaceName a a
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1)
deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
instance Eq1 JsxNamespaceName where liftEq = genericLiftEq
instance Ord1 JsxNamespaceName where liftCompare = genericLiftCompare

9
src/Prologue.hs
View File

@ -4,6 +4,8 @@ module Prologue
, foldMapA
, maybeM
, maybeFail
, maybeLast
, fromMaybeLast
) where
@ -61,6 +63,13 @@ import GHC.Stack as X
foldMapA :: (Alternative m, Foldable t) => (b -> m a) -> t b -> m a
foldMapA f = getAlt . foldMap (Alt . f)
maybeLast :: Foldable t => b -> (a -> b) -> t a -> b
maybeLast b f = maybe b f . getLast . foldMap (Last . Just)
fromMaybeLast :: Foldable t => a -> t a -> a
fromMaybeLast b = fromMaybe b . getLast . foldMap (Last . Just)
-- | Extract the 'Just' of a 'Maybe' in an 'Applicative' context or, given 'Nothing', run the provided action.
maybeM :: Applicative f => f a -> Maybe a -> f a
maybeM f = maybe f pure

5
src/Semantic/CLI.hs
View File

@ -34,8 +34,8 @@ runDiff (SomeRenderer diffRenderer) = Semantic.diffBlobPairs diffRenderer <=< Ta
runParse :: SomeRenderer TermRenderer -> Either Handle [(FilePath, Maybe Language)] -> Task.TaskEff ByteString
runParse (SomeRenderer parseTreeRenderer) = Semantic.parseBlobs parseTreeRenderer <=< Task.readBlobs
runGraph :: SomeRenderer GraphRenderer -> (FilePath, Maybe Language) -> Task.TaskEff ByteString
runGraph (SomeRenderer r) = Semantic.graph r <=< Task.readBlob
runGraph :: SomeRenderer GraphRenderer -> Maybe FilePath -> (FilePath, Maybe Language) -> Task.TaskEff ByteString
runGraph (SomeRenderer r) rootDir = Semantic.graph rootDir r <=< Task.readBlob
-- | A parser for the application's command-line arguments.
--
@ -94,6 +94,7 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
<$> ( flag (SomeRenderer DOTGraphRenderer) (SomeRenderer DOTGraphRenderer) (long "dot" <> help "Output in DOT graph format (default)")
<|> flag' (SomeRenderer JSONGraphRenderer) (long "json" <> help "Output JSON graph")
)
<*> optional (strOption (long "root" <> help "Root directory of project. Optional, defaults to entry file's directory." <> metavar "DIRECTORY"))
<*> argument filePathReader (metavar "ENTRY_FILE")
filePathReader = eitherReader parseFilePath

22
src/Semantic/Graph.hs
View File

@ -4,7 +4,10 @@ module Semantic.Graph where
import qualified Analysis.Abstract.ImportGraph as Abstract
import qualified Data.Abstract.Evaluatable as Analysis
import Data.Abstract.FreeVariables
import qualified Data.Abstract.ModuleTable as ModuleTable
import Data.Abstract.Package
import Data.Blob
import Data.List (intercalate)
import Data.ByteString.Char8 as BC (pack)
import Data.Output
import Parsing.Parser
@ -14,14 +17,23 @@ import Semantic.IO (Files, NoLanguageForBlob (..))
import Semantic.Task
import System.FilePath.Posix
graph :: (Members '[Distribute WrappedTask, Files, Task, Exc SomeException] effs) => GraphRenderer output -> Blob -> Eff effs ByteString
graph renderer Blob{..}
graph :: (Members '[Distribute WrappedTask, Files, Task, Exc SomeException, Telemetry] effs)
=> Maybe FilePath
-> GraphRenderer output
-> Blob
-> Eff effs ByteString
graph maybeRootDir renderer Blob{..}
| Just (SomeAnalysisParser parser exts preludePath) <- someAnalysisParser
(Proxy :: Proxy '[ Analysis.Evaluatable, FreeVariables1, Functor, Eq1, Ord1, Show1 ]) <$> blobLanguage = do
let rootDir = takeDirectory blobPath
(Proxy :: Proxy '[ Analysis.Evaluatable, Analysis.Declarations1, FreeVariables1, Functor, Eq1, Ord1, Show1 ]) <$> blobLanguage = do
let rootDir = fromMaybe (takeDirectory blobPath) maybeRootDir
paths <- filter (/= blobPath) <$> listFiles rootDir exts
prelude <- traverse (parseModule parser Nothing) preludePath
package <- parsePackage (packageName blobPath) parser rootDir (blobPath : paths)
let name = packageName blobPath
package <- parsePackage name parser rootDir (blobPath : paths)
let modulePaths = intercalate "," $ ModuleTable.keys (packageModules (packageBody package))
writeLog Info ("Package " <> show name <> " loaded") [("paths", modulePaths)]
graphImports prelude package >>= case renderer of
JSONGraphRenderer -> pure . toOutput
DOTGraphRenderer -> pure . Abstract.renderImportGraph

2
src/Semantic/Log.hs
View File

@ -68,7 +68,7 @@ terminalFormatter :: Options -> Message -> String
terminalFormatter Options{..} (Message level message pairs time) =
showChar '[' . showTime time . showString "] "
. showLevel level . showChar ' '
. showString (printf "%-20s" message)
. showString (printf "%-20s " message)
. showPairs pairs
. showChar '\n' $ ""
where

1
src/Semantic/Task.hs
View File

@ -147,6 +147,7 @@ type ImportGraphAnalysis term effects value =
graphImports :: (
Show ann
, Ord ann
, Apply Analysis.Declarations1 syntax
, Apply Analysis.Evaluatable syntax
, Apply FreeVariables1 syntax
, Apply Functor syntax

7
src/Semantic/Util.hs
View File

@ -80,8 +80,15 @@ evalTypeScriptProject path = runEvaluating . evaluatePackageBody <$> parseProjec
evalTypeScriptFile path = runEvaluating . evaluateModule <$> parseFile typescriptParser Nothing path
typecheckTypeScriptFile path = runAnalysis @(Caching (Evaluating Monovariant TypeScript.Term Type)) . evaluateModule <$> parseFile typescriptParser Nothing path
-- JavaScript
evalJavaScriptProject path = runAnalysis @(EvaluatingWithHoles TypeScript.Term) . evaluatePackageBody <$> parseProject typescriptParser ["js"] path
runEvaluatingWithPrelude parser exts path = runEvaluating <$> (withPrelude <$> parsePrelude parser <*> (evaluatePackageBody <$> parseProject parser exts path))
type EvaluatingWithHoles term = BadModuleResolutions (BadVariables (BadValues (Quietly (Evaluating (Located Precise term) term (Value (Located Precise term))))))
type ImportGraphingWithHoles term = ImportGraphing (EvaluatingWithHoles term)
-- TODO: Remove this by exporting EvaluatingEffects
runEvaluating :: forall term effects a.
( Effects Precise term (Value Precise) (Evaluating Precise term (Value Precise) effects) ~ effects

3
test/Analysis/TypeScript/Spec.hs
View File

@ -2,6 +2,7 @@
module Analysis.TypeScript.Spec (spec) where
import SpecHelpers
import Data.Abstract.Evaluatable
spec :: Spec
@ -29,7 +30,7 @@ spec = parallel $ do
it "fails exporting symbols not defined in the module" $ do
v <- fst <$> evaluate "bad-export.ts"
v `shouldBe` Left "module \"foo.ts\" does not export \"pip\""
v `shouldBe` Right (Right (Right (Right (Right (Left (SomeExc $ ExportError "foo.ts" (Name "pip")))))))
where
fixtures = "test/fixtures/typescript/analysis/"

20
test/Data/Abstract/Path/Spec.hs Normal file
View File

@ -0,0 +1,20 @@
module Data.Abstract.Path.Spec(spec) where
import Data.Abstract.Path
import SpecHelpers
spec :: Spec
spec = parallel $
describe "joinPaths" $ do
it "joins empty paths" $
joinPaths "" "" `shouldBe` "."
it "joins relative paths" $
joinPaths "a/b" "./c" `shouldBe` "a/b/c"
it "joins absolute paths" $
joinPaths "/a/b" "c" `shouldBe` "/a/b/c"
it "walks up directories for ../" $
joinPaths "a/b" "../c" `shouldBe` "a/c"
it "walks up directories for multiple ../" $
joinPaths "a/b" "../../c" `shouldBe` "c"
it "stops walking at top directory" $
joinPaths "a/b" "../../../c" `shouldBe` "c"

2
test/Spec.hs
View File

@ -7,6 +7,7 @@ import qualified Analysis.Ruby.Spec
import qualified Analysis.TypeScript.Spec
import qualified Assigning.Assignment.Spec
import qualified Data.Diff.Spec
import qualified Data.Abstract.Path.Spec
import qualified Data.Functor.Classes.Generic.Spec
import qualified Data.Mergeable.Spec
import qualified Data.Scientific.Spec
@ -35,6 +36,7 @@ main = hspec $ do
describe "Analysis.TypeScript" Analysis.TypeScript.Spec.spec
describe "Assigning.Assignment" Assigning.Assignment.Spec.spec
describe "Data.Diff" Data.Diff.Spec.spec
describe "Data.Abstract.Path" Data.Abstract.Path.Spec.spec
describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec
describe "Data.Mergeable" Data.Mergeable.Spec.spec
describe "Data.Scientific" Data.Scientific.Spec.spec

5
test/fixtures/javascript/analysis/foo.js vendored Normal file
View File

@ -0,0 +1,5 @@
module.exports.bar = bar
function bar() {
return "this is the bar function";
}

3
test/fixtures/javascript/analysis/main.js vendored Normal file
View File

@ -0,0 +1,3 @@
const foo = require('./foo')
foo.bar()

58
test/fixtures/python/async-function-definition.diffA-B.txt vendored
View File

@ -1,38 +1,30 @@
(Program
{+(Annotation
{+(Annotation
{+(Function
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+})+}
{+(Empty)+})+}
{+(Identifier)+})+}
{+(Function
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+})+}
{+(Empty)+})+}
(Annotation
(Annotation
(Function
(Identifier)
{ (Identifier)
->(Identifier) })
(Empty))
(Identifier))
(Function
(Identifier)
{ (Identifier)
->(Identifier) })
(Empty))
(Annotation
(Annotation
(Function
{ (Identifier)
->(Identifier) }
{ (Identifier)
->(Identifier) }
{-(Identifier)-}
{ (Identifier)
->(Identifier) })
(Empty))
(Identifier))
(Function
{ (Identifier)
->(Identifier) }
{ (Identifier)
->(Identifier) }
{-(Identifier)-}
{ (Identifier)
->(Identifier) })
(Empty))
{-(Annotation
{-(Annotation
{-(Function
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-})-}
{-(Empty)-})-}
{-(Identifier)-})-})
{-(Function
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-})-}
{-(Empty)-})-})

58
test/fixtures/python/async-function-definition.diffB-A.txt vendored
View File

@ -1,38 +1,30 @@
(Program
{-(Annotation
{-(Annotation
{-(Function
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-})-}
{-(Empty)-})-}
{-(Identifier)-})-}
{-(Function
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-}
{-(Identifier)-})-}
{-(Empty)-})-}
(Annotation
(Annotation
(Function
(Identifier)
{ (Identifier)
->(Identifier) })
(Empty))
(Identifier))
(Function
(Identifier)
{ (Identifier)
->(Identifier) })
(Empty))
(Annotation
(Annotation
(Function
{ (Identifier)
->(Identifier) }
{ (Identifier)
->(Identifier) }
{+(Identifier)+}
{ (Identifier)
->(Identifier) })
(Empty))
(Identifier))
(Function
{ (Identifier)
->(Identifier) }
{ (Identifier)
->(Identifier) }
{+(Identifier)+}
{ (Identifier)
->(Identifier) })
(Empty))
{+(Annotation
{+(Annotation
{+(Function
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+})+}
{+(Empty)+})+}
{+(Identifier)+})+})
{+(Function
{+(Identifier)+}
{+(Identifier)+}
{+(Identifier)+})+}
{+(Empty)+})+})

36
test/fixtures/python/async-function-definition.parseA.txt vendored
View File

@ -1,25 +1,19 @@
(Program
(Annotation
(Annotation
(Function
(Identifier)
(Identifier))
(Empty))
(Identifier))
(Function
(Identifier)
(Identifier))
(Empty))
(Annotation
(Annotation
(Function
(Identifier)
(Identifier)
(Identifier)
(Identifier))
(Empty))
(Identifier))
(Function
(Identifier)
(Identifier)
(Identifier)
(Identifier))
(Empty))
(Annotation
(Annotation
(Function
(Identifier)
(Identifier)
(Identifier))
(Empty))
(Identifier)))
(Function
(Identifier)
(Identifier)
(Identifier))
(Empty)))

36
test/fixtures/python/async-function-definition.parseB.txt vendored
View File

@ -1,25 +1,19 @@
(Program
(Annotation
(Annotation
(Function
(Identifier)
(Identifier)
(Identifier)
(Identifier))
(Empty))
(Identifier))
(Function
(Identifier)
(Identifier)
(Identifier)
(Identifier))
(Empty))
(Annotation
(Annotation
(Function
(Identifier)
(Identifier))
(Empty))
(Identifier))
(Function
(Identifier)
(Identifier))
(Empty))
(Annotation
(Annotation
(Function
(Identifier)
(Identifier)
(Identifier))
(Empty))
(Identifier)))
(Function
(Identifier)
(Identifier)
(Identifier))
(Empty)))

3
test/fixtures/ruby/calls.parseA.txt vendored
View File

@ -6,8 +6,7 @@
(Send
(Identifier))
(KeyValue
(Send
(Identifier))
(Symbol)
(Integer))
(KeyValue
(Symbol)

12
test/fixtures/ruby/hash.diffA-B.txt vendored
View File

@ -2,20 +2,17 @@
(Hash
(KeyValue
{ (Symbol)
->(Send
{+(Identifier)+}) }
->(Symbol) }
{ (TextElement)
->(TextElement) })
(KeyValue
{ (Symbol)
->(Send
{+(Identifier)+}) }
->(Symbol) }
{ (Integer)
->(Integer) })
(KeyValue
{ (TextElement)
->(Send
{+(Identifier)+}) }
->(Symbol) }
{ (Boolean)
->(Boolean) })
{-(KeyValue
@ -26,8 +23,7 @@
{-(Context
{-(Comment)-}
{-(KeyValue
{-(Send
{-(Identifier)-})-}
{-(Symbol)-}
{-(Integer)-})-})-}
{-(Context
{-(Comment)-}

12
test/fixtures/ruby/hash.diffB-A.txt vendored
View File

@ -1,20 +1,17 @@
(Program
(Hash
(KeyValue
{ (Send
{-(Identifier)-})
{ (Symbol)
->(Symbol) }
{ (TextElement)
->(TextElement) })
(KeyValue
{ (Send
{-(Identifier)-})
{ (Symbol)
->(Symbol) }
{ (Integer)
->(Integer) })
(KeyValue
{ (Send
{-(Identifier)-})
{ (Symbol)
->(TextElement) }
{ (Boolean)
->(Boolean) })
@ -26,8 +23,7 @@
{+(Context
{+(Comment)+}
{+(KeyValue
{+(Send
{+(Identifier)+})+}
{+(Symbol)+}
{+(Integer)+})+})+}
{+(Context
{+(Comment)+}

3
test/fixtures/ruby/hash.parseA.txt vendored
View File

@ -17,8 +17,7 @@
(Context
(Comment)
(KeyValue
(Send
(Identifier))
(Symbol)
(Integer)))
(Context
(Comment)

9
test/fixtures/ruby/hash.parseB.txt vendored
View File

@ -1,14 +1,11 @@
(Program
(Hash
(KeyValue
(Send
(Identifier))
(Symbol)
(TextElement))
(KeyValue
(Send
(Identifier))
(Symbol)
(Integer))
(KeyValue
(Send
(Identifier))
(Symbol)
(Boolean))))

6
test/fixtures/ruby/method-calls-keyword-args.diffA-B.txt vendored
View File

@ -2,10 +2,8 @@
(Send
(Identifier)
(KeyValue
(Send
(Identifier))
(Symbol)
(Boolean))
{+(KeyValue
{+(Send
{+(Identifier)+})+}
{+(Symbol)+}
{+(Integer)+})+}))

6
test/fixtures/ruby/method-calls-keyword-args.diffB-A.txt vendored
View File

@ -2,10 +2,8 @@
(Send
(Identifier)
(KeyValue
(Send
(Identifier))
(Symbol)
(Boolean))
{-(KeyValue
{-(Send
{-(Identifier)-})-}
{-(Symbol)-}
{-(Integer)-})-}))

3
test/fixtures/ruby/method-calls-keyword-args.parseA.txt vendored
View File

@ -2,6 +2,5 @@
(Send
(Identifier)
(KeyValue
(Send
(Identifier))
(Symbol)
(Boolean))))

6
test/fixtures/ruby/method-calls-keyword-args.parseB.txt vendored
View File

@ -2,10 +2,8 @@
(Send
(Identifier)
(KeyValue
(Send
(Identifier))
(Symbol)
(Boolean))
(KeyValue
(Send
(Identifier))
(Symbol)
(Integer))))

3
test/fixtures/ruby/method-calls.diffA-B.txt vendored
View File

@ -14,8 +14,7 @@
{-(Symbol)-}
{-(Integer)-})-}
{-(KeyValue
{-(Send
{-(Identifier)-})-}
{-(Symbol)-}
{-(Integer)-})-})-}
{-(Send
{-(Identifier)-}

3
test/fixtures/ruby/method-calls.diffB-A.txt vendored
View File

@ -14,8 +14,7 @@
{+(Symbol)+}
{+(Integer)+})+}
{+(KeyValue
{+(Send
{+(Identifier)+})+}
{+(Symbol)+}
{+(Integer)+})+})+}
{+(Send
{+(Identifier)+}

3
test/fixtures/ruby/method-calls.parseA.txt vendored
View File

@ -13,8 +13,7 @@
(Symbol)
(Integer))
(KeyValue
(Send
(Identifier))
(Symbol)
(Integer)))
(Send
(Identifier)

2
vendor/haskell-tree-sitter vendored

@ -1 +1 @@
Subproject commit 2e090ceb0c33393b7c2b920228cb6ce6b8e65811
Subproject commit 95316466eb752256acad81c64481d7be9d9ac2a5