This repository was archived by the owner on Apr 1, 2025. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 459
Expand file tree
/
Copy pathJavaScript.hs
More file actions
152 lines (116 loc) · 6.89 KB
/
Copy pathJavaScript.hs
File metadata and controls
152 lines (116 loc) · 6.89 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module Language.TypeScript.Syntax.JavaScript (module Language.TypeScript.Syntax.JavaScript) where
import Control.Abstract.Heap
import Control.Abstract.ScopeGraph hiding (Import)
import Data.Abstract.Evaluatable
import qualified Data.Abstract.ScopeGraph as ScopeGraph
import Data.Functor.Classes.Generic
import Data.Hashable.Lifted
import Data.JSON.Fields
import qualified Data.Map.Strict as Map
import Diffing.Algorithm
import GHC.Generics (Generic1)
import Language.TypeScript.Resolution
newtype ImplementsClause a = ImplementsClause { implementsClauseTypes :: [a] }
deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable)
instance Eq1 ImplementsClause where liftEq = genericLiftEq
instance Ord1 ImplementsClause where liftCompare = genericLiftCompare
instance Show1 ImplementsClause where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable ImplementsClause
data OptionalParameter a = OptionalParameter { optionalParameterContext :: ![a], optionalParameterSubject :: !a, optionalParameterAccessControl :: AccessControl }
deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable)
instance Eq1 OptionalParameter where liftEq = genericLiftEq
instance Ord1 OptionalParameter where liftCompare = genericLiftCompare
instance Show1 OptionalParameter where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable OptionalParameter
data RequiredParameter a = RequiredParameter { requiredParameterContext :: [a], requiredParameterSubject :: a, requiredParameterValue :: a, requiredParameterAccessControl :: AccessControl }
deriving (Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable)
instance Eq1 RequiredParameter where liftEq = genericLiftEq
instance Ord1 RequiredParameter where liftCompare = genericLiftCompare
instance Show1 RequiredParameter where liftShowsPrec = genericLiftShowsPrec
instance Declarations1 RequiredParameter where
liftDeclaredName declaredName RequiredParameter{..} = declaredName requiredParameterSubject
instance Evaluatable RequiredParameter where
eval eval ref RequiredParameter{..} = do
span <- ask @Span
_ <- declareMaybeName (declaredName requiredParameterSubject) Default Public span ScopeGraph.RequiredParameter Nothing
lhs <- ref requiredParameterSubject
rhs <- eval requiredParameterValue
case declaredName requiredParameterValue of
Just rhsName -> do
assocScope <- associatedScope (Declaration rhsName)
case assocScope of
Just assocScope' -> do
objectScope <- newScope (Map.singleton ScopeGraph.Import [ assocScope' ])
putSlotDeclarationScope lhs (Just objectScope) -- TODO: not sure if this is right
Nothing ->
pure ()
Nothing ->
pure ()
assign lhs rhs
pure rhs
data RestParameter a = RestParameter { restParameterContext :: ![a], restParameterSubject :: !a }
deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable)
instance Eq1 RestParameter where liftEq = genericLiftEq
instance Ord1 RestParameter where liftCompare = genericLiftCompare
instance Show1 RestParameter where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable RestParameter
data JavaScriptRequire a = JavaScriptRequire { javascriptRequireIden :: !a, javascriptRequireFrom :: ImportPath }
deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable)
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
((moduleScope, moduleFrame), _) <- require modulePath
case declaredName aliasTerm of
Just alias -> do
span <- ask @Span
importScope <- newScope (Map.singleton ScopeGraph.Import [ moduleScope ])
declare (Declaration alias) Default Public span ScopeGraph.UnqualifiedImport (Just importScope)
let scopeMap = Map.singleton moduleScope moduleFrame
aliasFrame <- newFrame importScope (Map.singleton ScopeGraph.Import scopeMap)
aliasSlot <- lookupSlot (Declaration alias)
assign aliasSlot =<< object aliasFrame
Nothing -> do
insertImportEdge moduleScope
insertFrameLink ScopeGraph.Import (Map.singleton moduleScope moduleFrame)
unit
data Debugger a = Debugger
deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable)
instance Eq1 Debugger where liftEq = genericLiftEq
instance Ord1 Debugger where liftCompare = genericLiftCompare
instance Show1 Debugger where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Debugger
data Super a = Super
deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable)
instance Eq1 Super where liftEq = genericLiftEq
instance Ord1 Super where liftCompare = genericLiftCompare
instance Show1 Super where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Super
data Undefined a = Undefined
deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable)
instance Eq1 Undefined where liftEq = genericLiftEq
instance Ord1 Undefined where liftCompare = genericLiftCompare
instance Show1 Undefined where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Undefined
data With a = With { withExpression :: !a, withBody :: !a }
deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable)
instance Eq1 With where liftEq = genericLiftEq
instance Ord1 With where liftCompare = genericLiftCompare
instance Show1 With where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable With
-- | A sequence expression such as Javascript or C's comma operator.
data AnnotatedExpression a = AnnotatedExpression { expression :: !a, typeAnnotation :: !a }
deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable)
instance Eq1 AnnotatedExpression where liftEq = genericLiftEq
instance Ord1 AnnotatedExpression where liftCompare = genericLiftCompare
instance Show1 AnnotatedExpression where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable AnnotatedExpression where
eval eval _ (AnnotatedExpression a b) = eval b >> eval a