3
3
{-# LANGUAGE LambdaCase #-}
4
4
{-# LANGUAGE OverloadedStrings #-}
5
5
{-# LANGUAGE RecordWildCards #-}
6
+ {-# LANGUAGE TypeApplications #-}
6
7
7
8
module Semantic.Api.StackGraph
8
9
( parseStackGraph ,
9
10
parseStackGraphBuilder ,
11
+ testStackGraph ,
10
12
TempStackGraph (.. ),
11
13
SGNode (.. ),
12
14
SGPath (.. ),
13
15
)
14
16
where
15
17
16
18
import qualified Algebra.Graph as Graph
19
+ import qualified Analysis.File as File
17
20
import qualified Analysis.Name as Name
21
+ import Control.Carrier.Parse.Measured
22
+ import Control.Carrier.Reader
18
23
import qualified Control.Carrier.Sketch.ScopeGraph as ScopeGraph
19
24
import Control.Effect.Error
20
- import Control.Effect.Parse
21
- import Control.Effect.Reader
22
25
import Control.Exception
23
26
import Control.Lens hiding ((|>) )
24
27
import Control.Monad.ST
25
28
import Data.Blob
26
29
import Data.ByteString.Builder
30
+ import Data.Flag
27
31
import Data.Foldable
28
32
import Data.Functor.Tagged
29
33
import Data.Int
@@ -46,12 +50,14 @@ import Proto.Semantic_Fields as P
46
50
import Proto.Semantic_JSON ()
47
51
import qualified Scope.Graph.Convert as Graph
48
52
import Semantic.Api.Bridge
49
- import Semantic.Config
53
+ import Semantic.Config as Config
50
54
import Semantic.Task
55
+ import Semantic.Task.Files
51
56
import Serializing.Format (Format )
52
57
import Source.Loc as Loc
53
58
import qualified Stack.Graph as Stack
54
59
import qualified Stack.Path as Path
60
+ import qualified System.Path as SystemPath
55
61
56
62
parseStackGraphBuilder ::
57
63
( Effect sig ,
@@ -67,6 +73,29 @@ parseStackGraphBuilder ::
67
73
parseStackGraphBuilder format blobs =
68
74
parseStackGraph blobs >>= serialize format
69
75
76
+ testOptions :: Config. Options
77
+ testOptions =
78
+ defaultOptions
79
+ { optionsFailOnWarning = flag FailOnWarning True ,
80
+ optionsLogLevel = Nothing
81
+ }
82
+
83
+ parseStackGraphFilePath ::
84
+ ( Has (Error SomeException ) sig m ,
85
+ Has Distribute sig m ,
86
+ Has Parse sig m ,
87
+ Has Files sig m ,
88
+ Effect sig
89
+ ) =>
90
+ SystemPath. RelFile ->
91
+ m StackGraphResponse
92
+ parseStackGraphFilePath path = readBlob (File. fromPath path) >>= runReader preciseLanguageModes . parseStackGraph . pure @ []
93
+
94
+ testStackGraph :: SystemPath. RelFile -> IO (Either SomeException StackGraphResponse )
95
+ testStackGraph path = withOptions testOptions $ \ config logger statter -> do
96
+ let session = TaskSession config " -" False logger statter
97
+ runTask session (runParse (parseStackGraphFilePath path))
98
+
70
99
parseStackGraph ::
71
100
( Has (Error SomeException ) sig m ,
72
101
Effect sig ,
0 commit comments