Try to give InterfaceLabel to the frontend

AmpersandTarski · Jul 4, 2024 · 7202075 · 7202075
1 parent 8b5dd90
commit 7202075
Show file tree

Hide file tree

Showing 7 changed files with 17 additions and 13 deletions.
diff --git a/src/Ampersand/ADL1/P2A_Converters.hs b/src/Ampersand/ADL1/P2A_Converters.hs
@@ -922,7 +922,7 @@ pCtx2aCtx
                                 ifcObj =
                                   o
                                     { objPlainName = Just . fullName1 . name $ pIfc,
-                                      objlbl = Nothing
+                                      objlbl = mLabel pIfc
                                     },
                                 ifcConjuncts = [], -- to be enriched in Adl2fSpec with rules to be checked
                                 ifcPos = origin pIfc,

diff --git a/src/Ampersand/ADL1/PrettyPrinters.hs b/src/Ampersand/ADL1/PrettyPrinters.hs
@@ -138,7 +138,7 @@ instance Pretty P_Pattern where
 instance Pretty P_Relation where
   pretty (P_Relation nm sign lbl prps dflts pragma mean _) =
     text "RELATION"
-      <+> (text . T.unpack . plainNameOf) nm <~> sign <~> lbl
+      <+> (text . T.unpack . localNameOf) nm <~> sign <~> lbl
       <+> props
       <+> if null dflts
         then empty
@@ -199,7 +199,7 @@ instance Pretty TermPrim where
     PNamedR rel -> pretty rel
 
 instance Pretty P_NamedRel where
-  pretty (PNamedRel _ str mpSign) = (text . T.unpack . plainNameOf) str <~> mpSign
+  pretty (PNamedRel _ str mpSign) = (text . T.unpack . localNameOf) str <~> mpSign
 
 instance Pretty (PairView TermPrim) where
   pretty (PairView ss) = text "VIOLATION" <+> parens (listOf1 ss)
@@ -306,7 +306,7 @@ prettyObject objectKind obj =
     crud (Just cruds) = pretty cruds
     view :: Maybe Name -> Doc
     view Nothing = empty
-    view (Just v) = (text . T.unpack) ("<" <> plainNameOf v <> ">")
+    view (Just v) = (text . T.unpack) ("<" <> localNameOf v <> ">")
     maybeQuoteLabel :: Maybe Text1 -> Doc
     maybeQuoteLabel lbl =
       case lbl of

diff --git a/src/Ampersand/Basics/Name.hs b/src/Ampersand/Basics/Name.hs
@@ -210,8 +210,8 @@ class Named a where
   nameSpaceOf = NE.init . nameParts . name
   localName :: a -> NamePart
   localName = NE.last . nameParts . name
-  plainNameOf :: a -> Text
-  plainNameOf = namePartToText . localName
+  localNameOf :: a -> Text
+  localNameOf = namePartToText . localName
   updatedName :: NamePart -> a -> Name
   updatedName txt1 x = Name ws' typ
     where
@@ -226,7 +226,7 @@ class (Named a) => Labeled a where
   mLabel :: a -> Maybe Label
   label :: a -> Text
   label x = case mLabel x of
-    Nothing -> plainNameOf x
+    Nothing -> localNameOf x
     Just (Label lbl) -> lbl
 
 instance Show Label where

diff --git a/src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs b/src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs
@@ -512,12 +512,12 @@ makeFSpec env context =
               nm' 0 =
                 mkName ConceptName
                   . NE.reverse
-                  $ (toNamePart' . plural (ctxlang context) . plainNameOf $ c)
+                  $ (toNamePart' . plural (ctxlang context) . localNameOf $ c)
                   NE.:| reverse (nameSpaceOf (name c))
               nm' i =
                 mkName ConceptName
                   . NE.reverse
-                  $ (toNamePart' . plural (ctxlang context) $ plainNameOf c <> tshow i)
+                  $ (toNamePart' . plural (ctxlang context) $ localNameOf c <> tshow i)
                   NE.:| reverse (nameSpaceOf (name c))
               nm = case [nm' i | i <- [0 ..], nm' i `notElem` map name (ctxifcs context)] of
                 [] -> fatal "impossible"

diff --git a/src/Ampersand/Prototype/GenAngularJSFrontend.hs b/src/Ampersand/Prototype/GenAngularJSFrontend.hs
@@ -83,6 +83,8 @@ genViewInterface fSpec interf = do
           . setAttribute "roles" (map tshow . feiRoles $ interf) -- show string, since StringTemplate does not elegantly allow to quote and separate
           . setAttribute "ampersandVersionStr" (longVersion appVersion)
           . setAttribute "interfaceName" (ifcName interf)
+          . setAttribute "interfaceNamePascal" (ifcNamePascal interf)
+          . setAttribute "interfaceNameKebab" (ifcNameKebab interf)
           . setAttribute "interfaceLabel" (ifcLabel interf) -- no escaping for labels in templates needed
           . setAttribute "expAdl" (showA . toExpr . ifcExp $ interf)
           . setAttribute "source" (text1ToText . idWithoutType' . source . ifcExp $ interf)
@@ -95,7 +97,7 @@ genViewInterface fSpec interf = do
           . setAttribute "verbose" (loglevel' == LevelDebug)
           . setAttribute "loglevel" (tshow loglevel')
   let filename :: FilePath
-      filename = "ifc" <> (T.unpack . ifcName $ interf) <> ".view.html"
+      filename = "ifc" <> (T.unpack . ifcNameKebab $ interf) <> ".view.html"
   writePrototypeAppFile filename contents
 
 -- Helper data structure to pass attribute values to HStringTemplate
@@ -244,6 +246,8 @@ genControllerInterface fSpec interf = do
           . setAttribute "roles" (feiRoles interf) -- show string, since StringTemplate does not elegantly allow to quote and separate
           . setAttribute "ampersandVersionStr" (longVersion appVersion)
           . setAttribute "interfaceName" (ifcName interf)
+          . setAttribute "interfaceNamePascal" (ifcNamePascal interf)
+          . setAttribute "interfaceNameKebab" (ifcNameKebab interf)
           . setAttribute "interfaceLabel" (ifcLabel interf) -- no escaping for labels in templates needed
           . setAttribute "expAdl" (showA . toExpr . ifcExp $ interf)
           . setAttribute "exprIsUni" (exprIsUni . feiObj $ interf)
@@ -256,5 +260,5 @@ genControllerInterface fSpec interf = do
           . setAttribute "verbose" (loglevel' == LevelDebug)
           . setAttribute "loglevel" (tshow loglevel')
           . setAttribute "usedTemplate" controlerTemplateName
-  let filename = "ifc" <> T.unpack (ifcName interf) <> ".controller.js"
+  let filename = "ifc" <> T.unpack (ifcNameKebab interf) <> ".controller.js"
   writePrototypeAppFile filename contents
diff --git a/src/Ampersand/Prototype/GenFrontend.hs b/src/Ampersand/Prototype/GenFrontend.hs
@@ -198,7 +198,7 @@ buildInterfaces fSpec = mapM buildInterface allIfcs
             return
               FEObjE
                 { objName = maybe "" text1ToText . objPlainName $ object,
-                  objLabel = text1ToText <$> objPlainName object,
+                  objLabel = tshow <$> objlbl object,
                   objExp = iExp',
                   objCrudC = crudC . objcrud $ object,
                   objCrudR = crudR . objcrud $ object,

diff --git a/src/Ampersand/Prototype/PHP.hs b/src/Ampersand/Prototype/PHP.hs
@@ -134,7 +134,7 @@ showPHP :: [Text] -> Text
 showPHP phpLines = T.unlines $ ["<?php"] <> phpLines <> ["?>"]
 
 tempDbName :: FSpec -> Text
-tempDbName fSpec = "TempDB_" <> plainNameOf fSpec
+tempDbName fSpec = "TempDB_" <> localNameOf fSpec
 
 -- | Database name should not contain specific characters. Also, it has some maximum length.
 -- mkValidDBName :: Text -> Text