Moving the duplicated code

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/World.hs

@@ -15,7 +15,8 @@ module DA.Daml.LF.Ast.World(
     lookupDataType,
     lookupChoice,
     lookupValue,
-    lookupModule
+    lookupModule,
+    typeConFields
     ) where
 
 import DA.Pretty
@@ -31,6 +32,8 @@ import DA.Daml.LF.Ast.Base
 import DA.Daml.LF.Ast.Optics (moduleModuleRef)
 import DA.Daml.LF.Ast.Pretty ()
 import DA.Daml.LF.Ast.Version
+import DA.Daml.LF.Ast.Util
+import qualified Data.Text as T
 
 -- | The 'World' contains all imported packages together with (a subset of)
 -- the modules of the current package. The latter shall always be closed under
@@ -127,6 +130,22 @@ lookupChoice (tplRef, chName) world = do
     Nothing -> Left (LEChoice tplRef chName)
     Just choice -> Right choice
 
+labledField :: T.Text -> T.Text -> T.Text
+labledField fname "" = fname
+labledField fname label = fname <> "." <> label
+
+typeConFieldsNames :: World -> (FieldName, Type) -> [T.Text]
+typeConFieldsNames world (FieldName fName, TConApp tcn _) = map (labledField fName) (typeConFields tcn world)
+typeConFieldsNames _ (FieldName fName, _) = [fName]
+
+typeConFields :: Qualified TypeConName -> World -> [T.Text]
+typeConFields qName world = case lookupDataType qName world of
+  Right dataType -> case dataCons dataType of
+    DataRecord re -> concatMap (typeConFieldsNames world) re
+    DataVariant _ -> [""]
+    DataEnum _ -> [""]
+  Left _ -> error "malformed template constructor"
+
 instance Pretty LookupError where
   pPrint = \case
     LEPackage pkgId -> "unknown package:" <-> pretty pkgId

compiler/damlc/daml-visual/src/DA/Daml/Visual.hs

@@ -153,23 +153,6 @@ 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"
 
--- This is copied from PrettyScenarios but depending on SS for visual seems odd
-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]
-
-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

compiler/scenario-service/client/src/DA/Daml/LF/PrettyScenario.hs

@@ -40,7 +40,6 @@ import           ScenarioService
 import qualified Text.Blaze.Html5 as H
 import qualified Text.Blaze.Html5.Attributes as A
 import qualified Text.Blaze.Html.Renderer.Text as Blaze
-
 data Error = ErrorMissingNode NodeId
 type M = ExceptT Error (Reader (MS.Map NodeId Node, LF.World))
 
@@ -810,28 +809,12 @@ templateConName (Identifier mbPkgId (TL.toStrict -> qualName)) = LF.Qualified pk
                   Just (PackageIdentifier Nothing) -> error "unidentified package reference"
                   Nothing -> error "unidentified package reference"
 
-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]
-
-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"
-
 renderHeader :: LF.World -> Identifier -> S.Set T.Text -> H.Html
 renderHeader world identifier parties = H.tr $ mconcat
             [ foldMap (H.th . (H.div H.! A.class_ "observer") . H.text) parties
             , H.th "id"
             , H.th "status"
-            , foldMap (H.th . H.text) (typeConFields (templateConName identifier) world)
+            , foldMap (H.th . H.text) (LF.typeConFields (templateConName identifier) world)
             ]
 
 renderRow :: LF.World -> S.Set T.Text -> NodeInfo -> H.Html