mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 09:17:43 +03:00
Adding fields to template graphs (#2673)
* Adding more info to dor
* Adding fields to the graph
* Spelling mistakes and params
* Removing single line function
* Moving the duplicated code
* Revert "Moving the duplicated code"
This reverts commit 520b5d9b0d.
* Adding more structure to graph
* Working tests with graph which is more easy to understand and change.
have few more tests to migrate
* Adding edge details
* One more to go
* Adding more verbose field information
* All tests now tests the fields that are being added
* Removing unused Import
* defined not refined
* Unused imports
* Names need to be consitent
* Acutal and Expected, not expected and expected
* Removing unused export
* Lints
This commit is contained in:
Anup Kalburgi
mergify[bot]
parent
1fa15ffb1d
commit
0a9e0a8911
@ -10,12 +10,12 @@
|
||||
-- | Testing framework for Shake API.
|
||||
module Development.IDE.Core.API.Testing
|
||||
( ShakeTest
|
||||
, TemplateProp(..)
|
||||
, ExpectedChoice(..)
|
||||
, GoToDefinitionPattern (..)
|
||||
, HoverExpectation (..)
|
||||
, D.DiagnosticSeverity(..)
|
||||
, ExpectedChoiceAction(..)
|
||||
, ExpectedGraph(..)
|
||||
, ExpectedSubGraph(..)
|
||||
, ExpectedChoiceDetails(..)
|
||||
, runShakeTest
|
||||
, makeFile
|
||||
, makeModule
|
||||
@ -39,7 +39,7 @@ module Development.IDE.Core.API.Testing
|
||||
, expectNoVirtualResource
|
||||
, expectVirtualResourceNote
|
||||
, expectNoVirtualResourceNote
|
||||
, expectedTemplatePoperties
|
||||
, expectedGraph
|
||||
, timedSection
|
||||
, example
|
||||
) where
|
||||
@ -60,7 +60,6 @@ import DA.Test.Util (standardizeQuotes)
|
||||
import Language.Haskell.LSP.Messages (FromServerMessage(..))
|
||||
import Language.Haskell.LSP.Types
|
||||
import qualified DA.Daml.Visual as V
|
||||
import qualified DA.Pretty as DAP
|
||||
import qualified DA.Daml.LF.Ast as LF
|
||||
|
||||
-- * external dependencies
|
||||
@ -104,7 +103,7 @@ data ShakeTestError
|
||||
| ExpectedVirtualResourceNote VirtualResource T.Text (Map VirtualResource T.Text)
|
||||
| ExpectedNoVirtualResourceNote VirtualResource (Map VirtualResource T.Text)
|
||||
| ExpectedNoErrors [D.FileDiagnostic]
|
||||
| ExpectedTemplateProps (Set.Set TemplateProp) (Set.Set TemplateProp)
|
||||
| ExpectedGraphProps ExpectedGraph V.Graph
|
||||
| ExpectedDefinition Cursor GoToDefinitionPattern (Maybe D.Location)
|
||||
| ExpectedHoverText Cursor HoverExpectation [T.Text]
|
||||
| TimedSectionTookTooLong Clock.NominalDiffTime Clock.NominalDiffTime
|
||||
@ -127,20 +126,21 @@ data ShakeTestEnv = ShakeTestEnv
|
||||
type TemplateName = String
|
||||
type ChoiceName = String
|
||||
|
||||
data ExpectedChoiceAction
|
||||
= Create TemplateName
|
||||
| Exercise TemplateName ChoiceName deriving (Eq, Ord, Show)
|
||||
|
||||
data ExpectedChoice = ExpectedChoice
|
||||
{ _cName :: String
|
||||
, _consuming :: Bool
|
||||
, _action :: Set.Set ExpectedChoiceAction
|
||||
data ExpectedChoiceDetails = ExpectedChoiceDetails
|
||||
{ expectedConsuming :: Bool
|
||||
, expectedName :: String
|
||||
} deriving (Eq, Ord, Show )
|
||||
|
||||
data TemplateProp = TemplateProp
|
||||
{ _tplName :: T.Text
|
||||
, _choices :: Set.Set ExpectedChoice
|
||||
} deriving (Eq, Ord, Show)
|
||||
data ExpectedSubGraph = ExpectedSubGraph
|
||||
{ expectedNodes :: [ChoiceName]
|
||||
, expectedTplFields :: [String]
|
||||
, expectedTemplate :: TemplateName
|
||||
} deriving (Eq, Ord, Show )
|
||||
|
||||
data ExpectedGraph = ExpectedGraph
|
||||
{ expectedSubgraphs :: [ExpectedSubGraph]
|
||||
, expectedEdges :: [(ExpectedChoiceDetails, ExpectedChoiceDetails)]
|
||||
} deriving (Eq, Ord, Show )
|
||||
|
||||
-- | Monad for specifying Shake API tests. This type is abstract.
|
||||
newtype ShakeTest t = ShakeTest (ExceptT ShakeTestError (ReaderT ShakeTestEnv IO) t)
|
||||
@ -538,33 +538,34 @@ timedSection targetDiffTime block = do
|
||||
throwError $ TimedSectionTookTooLong targetDiffTime actualDiffTime
|
||||
return value
|
||||
|
||||
actionsToChoiceActions :: Set.Set V.Action -> Set.Set ExpectedChoiceAction
|
||||
actionsToChoiceActions acts = Set.map expectedChcAction acts
|
||||
where expectedChcAction = \case
|
||||
V.ACreate tcon -> Create (DAP.renderPretty tcon)
|
||||
V.AExercise tcon choice -> Exercise (DAP.renderPretty tcon) (DAP.renderPretty choice)
|
||||
subgraphToExpectedSubgraph :: V.SubGraph -> ExpectedSubGraph
|
||||
subgraphToExpectedSubgraph vSubgraph = ExpectedSubGraph vNodes vFields vTplName
|
||||
where vNodes = map (T.unpack . LF.unChoiceName . V.displayChoiceName) (V.nodes vSubgraph)
|
||||
vFields = map T.unpack (V.templateFields vSubgraph)
|
||||
vTplName = T.unpack $ V.tplNameUnqual (V.clusterTemplate vSubgraph)
|
||||
|
||||
templateChoicesToProps :: V.TemplateChoices -> TemplateProp
|
||||
templateChoicesToProps tca = TemplateProp tName choicesInTpl
|
||||
where tName = V.tplNameUnqual (V.template tca)
|
||||
choicesInTpl = Set.fromList $ map (\ca -> ExpectedChoice (DAP.renderPretty $ V.choiceName ca) (V.choiceConsuming ca) (actionsToChoiceActions $ V.actions ca)) (V.choiceAndActions tca)
|
||||
graphToExpectedGraph :: V.Graph -> ExpectedGraph
|
||||
graphToExpectedGraph vGraph = ExpectedGraph vSubgrpaghs vEdges
|
||||
where vSubgrpaghs = map subgraphToExpectedSubgraph (V.subgraphs vGraph)
|
||||
vEdges = map (\(c1,c2) -> (expectedChcDetails c1, expectedChcDetails c2)) (V.edges vGraph)
|
||||
expectedChcDetails chc = ExpectedChoiceDetails (V.consuming chc)
|
||||
((T.unpack . LF.unChoiceName . V.displayChoiceName) chc)
|
||||
|
||||
graphTest :: LF.World -> LF.Package -> Set.Set TemplateProp -> ShakeTest ()
|
||||
graphTest wrld lfPkg expectedProps = do
|
||||
let actual = Set.fromList $ map templateChoicesToProps tplPropsActual
|
||||
tplPropsActual = concatMap (V.moduleAndTemplates wrld) (NM.toList $ LF.packageModules lfPkg)
|
||||
unless (expectedProps == actual) $
|
||||
throwError $ ExpectedTemplateProps expectedProps actual
|
||||
graphTest :: LF.World -> LF.Package -> ExpectedGraph -> ShakeTest ()
|
||||
graphTest wrld pkg expectedGraph = do
|
||||
let actualGraph = V.graphFromModule (NM.toList $ LF.packageModules pkg) wrld
|
||||
unless (expectedGraph == graphToExpectedGraph actualGraph) $
|
||||
throwError $ ExpectedGraphProps expectedGraph actualGraph
|
||||
|
||||
expectedTemplatePoperties :: D.NormalizedFilePath -> Set.Set TemplateProp -> ShakeTest ()
|
||||
expectedTemplatePoperties damlFilePath expectedProps = do
|
||||
-- Not using the ide call as we do not have a rule defined for visualization because of memory overhead
|
||||
expectedGraph :: D.NormalizedFilePath -> ExpectedGraph -> ShakeTest ()
|
||||
expectedGraph damlFilePath expectedGraph = do
|
||||
ideState <- ShakeTest $ Reader.asks steService
|
||||
mbDalf <- liftIO $ API.runAction ideState (API.getDalf damlFilePath)
|
||||
expectNoErrors
|
||||
Just lfPkg <- pure mbDalf
|
||||
wrld <- Reader.liftIO $ API.runAction ideState (API.worldForFile damlFilePath)
|
||||
graphTest wrld lfPkg expectedProps
|
||||
|
||||
graphTest wrld lfPkg expectedGraph
|
||||
|
||||
-- | Example testing scenario.
|
||||
example :: ShakeTest ()
|
||||
|
||||
@ -4,12 +4,15 @@
|
||||
-- | Main entry-point of the DAML compiler
|
||||
module DA.Daml.Visual
|
||||
( execVisual
|
||||
, moduleAndTemplates
|
||||
, tplNameUnqual
|
||||
, TemplateChoices(..)
|
||||
, ChoiceAndAction(..)
|
||||
, Action(..)
|
||||
, Graph(..)
|
||||
, SubGraph(..)
|
||||
, ChoiceDetails(..)
|
||||
, dotFileGen
|
||||
, graphFromModule
|
||||
) where
|
||||
|
||||
|
||||
@ -43,6 +46,7 @@ data ChoiceAndAction = ChoiceAndAction
|
||||
|
||||
data TemplateChoices = TemplateChoices
|
||||
{ template :: LF.Template
|
||||
, modName :: LF.ModuleName
|
||||
, choiceAndActions :: [ChoiceAndAction]
|
||||
} deriving (Show)
|
||||
|
||||
@ -50,12 +54,18 @@ data ChoiceDetails = ChoiceDetails
|
||||
{ nodeId :: Int
|
||||
, consuming :: Bool
|
||||
, displayChoiceName :: LF.ChoiceName
|
||||
}
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data SubGraph = SubGraph
|
||||
{ nodes :: [ChoiceDetails]
|
||||
, templateFields :: [T.Text]
|
||||
, clusterTemplate :: LF.Template
|
||||
}
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data Graph = Graph
|
||||
{ subgraphs :: [SubGraph]
|
||||
, edges :: [(ChoiceDetails, ChoiceDetails)]
|
||||
} deriving (Show, Eq)
|
||||
|
||||
startFromUpdate :: Set.Set (LF.Qualified LF.ExprValName) -> LF.World -> LF.Update -> Set.Set Action
|
||||
startFromUpdate seen world update = case update of
|
||||
@ -116,7 +126,7 @@ templatePossibleUpdates world tpl = map toActions $ NM.toList $ LF.tplChoices tp
|
||||
}
|
||||
|
||||
moduleAndTemplates :: LF.World -> LF.Module -> [TemplateChoices]
|
||||
moduleAndTemplates world mod = map (\t -> TemplateChoices t (templatePossibleUpdates world t)) $ NM.toList $ LF.moduleTemplates mod
|
||||
moduleAndTemplates world mod = map (\t -> TemplateChoices t (LF.moduleName mod) (templatePossibleUpdates world t)) $ NM.toList $ LF.moduleTemplates mod
|
||||
|
||||
dalfBytesToPakage :: BSL.ByteString -> ExternalPackage
|
||||
dalfBytesToPakage bytes = case Archive.decodeArchive $ BSL.toStrict bytes of
|
||||
@ -153,10 +163,29 @@ addCreateChoice :: TemplateChoices -> Map.Map LF.ChoiceName ChoiceDetails -> Cho
|
||||
addCreateChoice TemplateChoices {..} lookupData = nodeIdForChoice lookupData tplNameCreateChoice
|
||||
where tplNameCreateChoice = LF.ChoiceName $ T.pack $ DAP.renderPretty (headNote "addCreateChoice" (LF.unTypeConName (LF.tplTypeCon template))) ++ "_Create"
|
||||
|
||||
constructSubgraphsWithLables :: Map.Map LF.ChoiceName ChoiceDetails -> TemplateChoices -> SubGraph
|
||||
constructSubgraphsWithLables lookupData tpla@TemplateChoices {..} = SubGraph nodesWithCreate template
|
||||
labledField :: T.Text -> T.Text -> T.Text
|
||||
labledField fname "" = fname
|
||||
labledField fname label = fname <> "." <> label
|
||||
|
||||
typeConFieldsNames :: LF.World -> (LF.FieldName, LF.Type) -> [T.Text]
|
||||
typeConFieldsNames world (LF.FieldName fName, LF.TConApp tcn _) = map (labledField fName) (typeConFields tcn world)
|
||||
typeConFieldsNames _ (LF.FieldName fName, _) = [fName]
|
||||
|
||||
-- TODO: Anup This will fail if we were to recursively continue exploring the AST.
|
||||
typeConFields :: LF.Qualified LF.TypeConName -> LF.World -> [T.Text]
|
||||
typeConFields qName world = case LF.lookupDataType qName world of
|
||||
Right dataType -> case LF.dataCons dataType of
|
||||
LF.DataRecord re -> concatMap (typeConFieldsNames world) re
|
||||
LF.DataVariant _ -> [""]
|
||||
LF.DataEnum _ -> [""]
|
||||
Left _ -> error "malformed template constructor"
|
||||
|
||||
constructSubgraphsWithLables :: LF.World -> Map.Map LF.ChoiceName ChoiceDetails -> TemplateChoices -> SubGraph
|
||||
constructSubgraphsWithLables wrld lookupData tpla@TemplateChoices {..} = SubGraph nodesWithCreate fieldsInTemplate template
|
||||
where choicesInTemplate = map internalChcName choiceAndActions
|
||||
fieldsInTemplate = typeConFields qualTpl wrld
|
||||
nodes = map (nodeIdForChoice lookupData) choicesInTemplate
|
||||
qualTpl = LF.Qualified LF.PRSelf modName (LF.tplTypeCon template)
|
||||
nodesWithCreate = addCreateChoice tpla lookupData : nodes
|
||||
|
||||
tplNamet :: LF.TypeConName -> T.Text
|
||||
@ -175,8 +204,8 @@ graphEdges lookupData tplChcActions = map (\(chn1, chn2) -> (nodeIdForChoice loo
|
||||
where chcActionsFromAllTemplates = concatMap choiceAndActions tplChcActions
|
||||
choicePairsForTemplates = concatMap choiceActionToChoicePairs chcActionsFromAllTemplates
|
||||
|
||||
subGraphHeader :: LF.Template -> String
|
||||
subGraphHeader tpl = "subgraph cluster_" ++ (DAP.renderPretty $ head (LF.unTypeConName $ LF.tplTypeCon tpl)) ++ "{\n"
|
||||
subGraphHeader :: SubGraph -> String
|
||||
subGraphHeader sg = "subgraph cluster_" ++ (DAP.renderPretty $ head (LF.unTypeConName $ LF.tplTypeCon $ clusterTemplate sg)) ++ "{\n"
|
||||
|
||||
choiceDetailsColorCode :: IsConsuming -> String
|
||||
choiceDetailsColorCode True = "red"
|
||||
@ -185,28 +214,36 @@ choiceDetailsColorCode False = "green"
|
||||
subGraphBodyLine :: ChoiceDetails -> String
|
||||
subGraphBodyLine chc = "n" ++ show (nodeId chc)++ "[label=" ++ DAP.renderPretty (displayChoiceName chc) ++"][color=" ++ choiceDetailsColorCode (consuming chc) ++"]; "
|
||||
|
||||
subGraphEnd :: LF.Template -> String
|
||||
subGraphEnd tpl = "label=" ++ DAP.renderPretty (LF.tplTypeCon tpl) ++ ";color=" ++ "blue" ++ "\n}"
|
||||
subGraphEnd :: SubGraph -> String
|
||||
subGraphEnd sg = "label=<" ++ tHeader ++ tTitle ++ tBody ++ tclose ++ ">" ++ ";color=" ++ "blue" ++ "\n}"
|
||||
where tHeader = "<table align = \"left\" border=\"0\" cellborder=\"0\" cellspacing=\"1\">\n"
|
||||
tTitle = "<tr><td align=\"center\"><b>" ++ DAP.renderPretty (LF.tplTypeCon $ clusterTemplate sg) ++ "</b></td></tr>"
|
||||
tBody = concatMap fieldTableLine (templateFields sg)
|
||||
fieldTableLine field = "<tr><td align=\"left\">" ++ T.unpack field ++ "</td></tr> \n"
|
||||
tclose = "</table>"
|
||||
|
||||
subGraphCluster :: SubGraph -> String
|
||||
subGraphCluster SubGraph {..} = subGraphHeader clusterTemplate ++ unlines (map subGraphBodyLine nodes) ++ subGraphEnd clusterTemplate
|
||||
subGraphCluster sg@SubGraph {..} = subGraphHeader sg ++ unlines (map subGraphBodyLine nodes) ++ subGraphEnd sg
|
||||
|
||||
drawEdge :: ChoiceDetails -> ChoiceDetails -> String
|
||||
drawEdge n1 n2 = "n" ++ show (nodeId n1) ++ "->" ++ "n" ++ show (nodeId n2)
|
||||
|
||||
constructDotGraph :: [SubGraph] -> [(ChoiceDetails, ChoiceDetails)] -> String
|
||||
constructDotGraph subgraphs edges = "digraph G {\ncompound=true;\n" ++ "rankdir=LR;\n"++ graphLines ++ "\n}\n"
|
||||
where subgraphsLines = concatMap subGraphCluster subgraphs
|
||||
edgesLines = unlines $ map (uncurry drawEdge) edges
|
||||
constructDotGraph :: Graph -> String
|
||||
constructDotGraph graph = "digraph G {\ncompound=true;\n" ++ "rankdir=LR;\n"++ graphLines ++ "\n}\n"
|
||||
where subgraphsLines = concatMap subGraphCluster (subgraphs graph)
|
||||
edgesLines = unlines $ map (uncurry drawEdge) (edges graph)
|
||||
graphLines = subgraphsLines ++ edgesLines
|
||||
|
||||
graphFromModule :: [LF.Module] -> LF.World -> Graph
|
||||
graphFromModule modules world = Graph subGraphs edges
|
||||
where templatesAndModules = concatMap (moduleAndTemplates world) modules
|
||||
nodes = choiceNameWithId templatesAndModules
|
||||
subGraphs = map (constructSubgraphsWithLables world nodes) templatesAndModules
|
||||
edges = graphEdges nodes templatesAndModules
|
||||
|
||||
|
||||
dotFileGen :: [LF.Module] -> LF.World -> String
|
||||
dotFileGen modules world = constructDotGraph subgraphClusters graphConnectedEdges
|
||||
where templatesAndModules = concatMap (moduleAndTemplates world) modules
|
||||
nodeWorld = choiceNameWithId templatesAndModules
|
||||
subgraphClusters = map (constructSubgraphsWithLables nodeWorld) templatesAndModules
|
||||
graphConnectedEdges = graphEdges nodeWorld templatesAndModules
|
||||
dotFileGen modules world = constructDotGraph $ graphFromModule modules world
|
||||
|
||||
execVisual :: FilePath -> Maybe FilePath -> IO ()
|
||||
execVisual darFilePath dotFilePath = do
|
||||
|
||||
@ -167,6 +167,7 @@ da_haskell_test(
|
||||
"//compiler/damlc/daml-compiler",
|
||||
"//compiler/damlc/daml-ide-core",
|
||||
"//compiler/damlc/daml-ide-core:ide-testing",
|
||||
"//compiler/damlc/daml-visual",
|
||||
"//compiler/hie-core",
|
||||
"//libs-haskell/da-hs-base",
|
||||
],
|
||||
|
||||
@ -16,7 +16,6 @@ import qualified Test.Tasty.HUnit as Tasty
|
||||
import qualified Data.Text.Extended as T
|
||||
|
||||
import Data.Either
|
||||
import qualified Data.Set as Set
|
||||
import System.Directory
|
||||
import System.Environment.Blank (setEnv)
|
||||
import Control.Monad.IO.Class
|
||||
@ -955,14 +954,13 @@ visualDamlTests = Tasty.testGroup "Visual Tests"
|
||||
, " do return ()"
|
||||
]
|
||||
setFilesOfInterest [foo]
|
||||
expectedTemplatePoperties foo $ Set.fromList
|
||||
[TemplateProp "Coin"
|
||||
(Set.fromList
|
||||
[ExpectedChoice "Archive" True Set.empty,
|
||||
ExpectedChoice "Delete" True Set.empty
|
||||
]
|
||||
)
|
||||
]
|
||||
expectedGraph foo (
|
||||
ExpectedGraph {expectedSubgraphs =
|
||||
[ExpectedSubGraph {expectedNodes = ["Create","Archive","Delete"]
|
||||
, expectedTplFields = ["owner"]
|
||||
, expectedTemplate = "Coin"}
|
||||
]
|
||||
, expectedEdges = []})
|
||||
, testCase' "Fetch shoud not be an create action" $ do
|
||||
fetchTest <- makeModule "F"
|
||||
[ "template Coin"
|
||||
@ -980,13 +978,11 @@ visualDamlTests = Tasty.testGroup "Visual Tests"
|
||||
]
|
||||
setFilesOfInterest [fetchTest]
|
||||
expectNoErrors
|
||||
expectedTemplatePoperties fetchTest $ Set.fromList
|
||||
[TemplateProp "Coin"
|
||||
(Set.fromList
|
||||
[ ExpectedChoice "Archive" True Set.empty,
|
||||
ExpectedChoice "ReducedCoin" False Set.empty
|
||||
])
|
||||
]
|
||||
expectedGraph fetchTest ( ExpectedGraph {expectedSubgraphs =
|
||||
[ExpectedSubGraph {expectedNodes = ["Create","Archive","ReducedCoin"]
|
||||
, expectedTplFields = ["owner","amount"]
|
||||
, expectedTemplate = "Coin"}]
|
||||
, expectedEdges = []})
|
||||
, testCase' "Exercise should add an edge" $ do
|
||||
exerciseTest <- makeModule "F"
|
||||
[ "template TT"
|
||||
@ -1009,18 +1005,20 @@ visualDamlTests = Tasty.testGroup "Visual Tests"
|
||||
]
|
||||
setFilesOfInterest [exerciseTest]
|
||||
expectNoErrors
|
||||
expectedTemplatePoperties exerciseTest $ Set.fromList
|
||||
[TemplateProp "Coin"
|
||||
(Set.fromList
|
||||
[ ExpectedChoice "Archive" True Set.empty,
|
||||
ExpectedChoice "Delete" True Set.empty
|
||||
])
|
||||
, TemplateProp "TT"
|
||||
(Set.fromList
|
||||
[ ExpectedChoice "Consume" True (Set.fromList [Exercise "F:Coin" "Delete"]),
|
||||
ExpectedChoice "Archive" True Set.empty
|
||||
])
|
||||
]
|
||||
expectedGraph exerciseTest (ExpectedGraph
|
||||
[ ExpectedSubGraph { expectedNodes = ["Create", "Archive", "Delete"]
|
||||
, expectedTplFields = ["owner"]
|
||||
, expectedTemplate = "Coin"
|
||||
}
|
||||
, ExpectedSubGraph { expectedNodes = ["Create", "Archive", "Consume"]
|
||||
, expectedTplFields = ["owner"]
|
||||
, expectedTemplate = "TT"}]
|
||||
|
||||
[(ExpectedChoiceDetails {expectedConsuming = True
|
||||
, expectedName = "Consume"},
|
||||
ExpectedChoiceDetails {expectedConsuming = True
|
||||
, expectedName = "Delete"})
|
||||
])
|
||||
, testCase' "Create on other template should be edge" $ do
|
||||
createTest <- makeModule "F"
|
||||
[ "template TT"
|
||||
@ -1039,16 +1037,16 @@ visualDamlTests = Tasty.testGroup "Visual Tests"
|
||||
]
|
||||
setFilesOfInterest [createTest]
|
||||
expectNoErrors
|
||||
expectedTemplatePoperties createTest $ Set.fromList
|
||||
[TemplateProp "Coin"
|
||||
(Set.fromList
|
||||
[ExpectedChoice "Archive" True Set.empty])
|
||||
, TemplateProp "TT"
|
||||
(Set.fromList
|
||||
[ ExpectedChoice "CreateCoin" True (Set.fromList [Create "F:Coin"]),
|
||||
ExpectedChoice "Archive" True Set.empty
|
||||
])
|
||||
]
|
||||
expectedGraph createTest (ExpectedGraph
|
||||
{expectedSubgraphs = [ExpectedSubGraph {expectedNodes = ["Create","Archive"]
|
||||
, expectedTplFields = ["owner"]
|
||||
, expectedTemplate = "Coin"}
|
||||
, ExpectedSubGraph {expectedNodes = ["Create","Archive","CreateCoin"]
|
||||
, expectedTplFields = ["owner"]
|
||||
, expectedTemplate = "TT"}]
|
||||
, expectedEdges = [(ExpectedChoiceDetails {expectedConsuming = True, expectedName = "CreateCoin"}
|
||||
,ExpectedChoiceDetails {expectedConsuming = False, expectedName = "Create"})]})
|
||||
|
||||
]
|
||||
where
|
||||
testCase' = testCase Nothing
|
||||
|
||||
@ -435,7 +435,7 @@ executeCommandTests run _ = testGroup "execute command"
|
||||
Just escapedFp <- pure $ uriToFilePath (main' ^. uri)
|
||||
actualDotString :: ExecuteCommandResponse <- LSP.request WorkspaceExecuteCommand $ ExecuteCommandParams
|
||||
"daml/damlVisualize" (Just (List [Aeson.String $ T.pack escapedFp]))
|
||||
let expectedDotString = "digraph G {\ncompound=true;\nrankdir=LR;\nsubgraph cluster_Coin{\nn0[label=Create][color=green]; \nn1[label=Archive][color=red]; \nn2[label=Delete][color=red]; \nlabel=Coin;color=blue\n}\n}\n"
|
||||
let expectedDotString = "digraph G {\ncompound=true;\nrankdir=LR;\nsubgraph cluster_Coin{\nn0[label=Create][color=green]; \nn1[label=Archive][color=red]; \nn2[label=Delete][color=red]; \nlabel=<<table align = \"left\" border=\"0\" cellborder=\"0\" cellspacing=\"1\">\n<tr><td align=\"center\"><b>Coin</b></td></tr><tr><td align=\"left\">owner</td></tr> \n</table>>;color=blue\n}\n}\n"
|
||||
liftIO $ assertEqual "Visulization command" (Just expectedDotString) (_result actualDotString)
|
||||
closeDoc main'
|
||||
, testCase "Invalid commands result in empty response" $ run $ do
|
||||
|
||||
Loading…
Reference in New Issue
Block a user