IDENT statement now can have a LABEL

src/Ampersand/ADL1/Disambiguate.hs

@@ -104,11 +104,11 @@ propagateConstraints topDown bottomUp =
     }
 
 instance Disambiguatable P_IdentDf where
-  disambInfo cptMap (P_Id o nm c atts) _ = (P_Id o nm c atts', Cnstr (concatMap bottomUpSourceTypes . NE.toList $ restr') [])
+  disambInfo cptMap (P_Id orig nm lbl cpt atts) _ = (P_Id orig nm lbl cpt atts', Cnstr (concatMap bottomUpSourceTypes . NE.toList $ restr') [])
     where
       (atts', restr') =
         NE.unzip $
-          fmap (\a -> disambInfo cptMap a (Cnstr [MustBe (pCpt2aCpt cptMap c)] [])) atts
+          fmap (\a -> disambInfo cptMap a (Cnstr [MustBe (pCpt2aCpt cptMap cpt)] [])) atts
 
 instance Disambiguatable P_IdentSegmnt where
   disambInfo cptMap (P_IdentExp v) x = (P_IdentExp v', rt)

src/Ampersand/ADL1/P2A_Converters.hs

@@ -1098,12 +1098,14 @@ pCtx2aCtx
         case disambiguate cptMap (termPrimDisAmb cptMap (declDisambMap ci)) pidt of
           P_Id
             { ix_name = nm,
+              ix_label = lbl',
               ix_ats = isegs
             } ->
               ( \isegs' ->
                   Id
                     { idPos = orig,
                       idName = nm,
+                      idlabel = lbl',
                       idCpt = conc,
                       idPat = mPat,
                       identityAts = isegs'

src/Ampersand/ADL1/PrettyPrinters.hs

@@ -333,8 +333,8 @@ instance Pretty (P_SubIfc TermPrim) where
                   )
 
 instance Pretty (P_IdentDf TermPrim) where
-  pretty (P_Id _ nm cpt ats) =
-    text "IDENT" <~> nm <+> text ":" <~> cpt <+> parens (listOf1 ats)
+  pretty (P_Id _ nm lbl cpt ats) =
+    text "IDENT" <~> nm <~> lbl <+> text ":" <~> cpt <+> parens (listOf1 ats)
 
 instance Pretty (P_IdentSegmnt TermPrim) where
   pretty (P_IdentExp obj) = prettyObject IdentSegmentKind obj

src/Ampersand/Core/A2P_Converters.hs

@@ -160,6 +160,7 @@ aIdentityDef2pIdentityDef iDef =
   P_Id
     { pos = idPos iDef,
       ix_name = idName iDef,
+      ix_label = idlabel iDef,
       ix_cpt = aConcept2pConcept (idCpt iDef),
       ix_ats = fmap aIdentitySegment2pIdentSegmnt (identityAts iDef)
     }

src/Ampersand/Core/AbstractSyntaxTree.hs

@@ -511,8 +511,10 @@ instance Traced Relation where
 data IdentityRule = Id
   { -- | The position of this definition in the text of the Ampersand source file (filename, line number and column number).
     idPos :: !Origin,
-    -- | the name (or label) of this Identity. The label has no meaning in the Compliant Service Layer, but is used in the generated user interface. It is not an empty string.
+    -- | the name of this Identity. The name has no meaning in the Compliant Service Layer, but is used in the generated user interface.
     idName :: !Name,
+    -- | a friendly, user readable alternative for the name
+    idlabel :: !(Maybe Label),
     -- | this term describes the instances of this object, related to their context
     idCpt :: !A_Concept,
     -- | if defined within a pattern, then the name of that pattern.

src/Ampersand/Core/ParseTree.hs

@@ -1009,8 +1009,10 @@ data P_IdentDf a -- so this is the parametric data-structure
   = P_Id
   { -- | position of this definition in the text of the Ampersand source file (filename, line number and column number).
     pos :: !Origin,
-    -- | the name (or label) of this Identity. The label has no meaning in the Compliant Service Layer, but is used in the generated user interface. It is not an empty string.
+    -- | the name of this Identity. The name has no meaning in the Compliant Service Layer, but is used in the generated user interface.
     ix_name :: !Name,
+    -- | a friendly, user readable alternative for the name
+    ix_label :: !(Maybe Label),
     -- | this term describes the instances of this object, related to their context
     ix_cpt :: !P_Concept,
     -- | the constituent segments of this identity. TODO: refactor to a list of terms
@@ -1043,7 +1045,7 @@ instance Functor P_IdentDf where fmap = fmapDefault
 instance Foldable P_IdentDf where foldMap = foldMapDefault
 
 instance Traversable P_IdentDf where
-  traverse f (P_Id a b c lst) = P_Id a b c <$> traverse (traverse f) lst
+  traverse f (P_Id orig nm lbl cpt lst) = P_Id orig nm lbl cpt <$> traverse (traverse f) lst
 
 instance Functor P_IdentSegmnt where fmap = fmapDefault
 

src/Ampersand/Input/ADL1/Parser.hs

@@ -610,12 +610,20 @@ pAdlTType =
 --- IdentDef ::= 'IDENT' Label ConceptRef '(' IndSegmentList ')'
 pIdentDef :: NameSpace -> AmpParser P_IdentDef
 pIdentDef ns =
-  P_Id <$> currPos
+  build <$> currPos
     <* (pKey . toText1Unsafe) "IDENT"
-    <*> (withNameSpace ns <$> pNameAndColon IdentName)
+    <*> pNameWithOptionalLabelAndColon ns IdentName
     <*> pConceptRef ns
     <*> pParens (pIdentSegment `sepBy1` pComma)
   where
+    build orig (nm, lbl) cpt lst =
+      P_Id
+        { ix_label = lbl,
+          ix_name = nm,
+          ix_cpt = cpt,
+          ix_ats = lst,
+          pos = orig
+        }
     --- IndSegmentList ::= Attr (',' Attr)*
     pIdentSegment :: AmpParser P_IdentSegment
     pIdentSegment = P_IdentExp <$> pAtt
@@ -1094,9 +1102,6 @@ pTex1AndColon = pUnrestrictedText1 <* pColon
 pUnrestrictedText1 :: AmpParser Text1
 pUnrestrictedText1 = (pSingleWord <|> pAnyKeyWord <|> pDoubleQuotedString1) <?> "identifier"
 
-pNameAndColon :: NameType -> AmpParser Name
-pNameAndColon typ = pName typ <* pColon
-
 pNameWithOptionalLabelAndColon ::
   NameSpace ->
   NameType ->

src/Ampersand/Test/Parser/ArbitraryTree.hs

@@ -469,6 +469,7 @@ instance Arbitrary P_Interface where
 instance Arbitrary P_IdentDef where
   arbitrary =
     P_Id <$> arbitrary
+      <*> arbitrary
       <*> arbitrary
       <*> arbitrary `suchThat` notIsOne
       <*> arbitrary