Merge branch 'main' into documentation

AmpersandData/FormalAmpersand/Interfaces.adl

@@ -58,8 +58,8 @@ PATTERN FormalAmpersand.StaticInterfaceStructure LABEL "Static Interface Structu
     CLASSIFY FormalAmpersand.Box,FormalAmpersand.InterfaceRef ISA FormalAmpersand.SubInterface
     RELATION FormalAmpersand.siConcept[FormalAmpersand.Box*FormalAmpersand.Concept][UNI,TOT]
     MEANING "The box concept is the type of the runtime atom of the box."
-    RELATION FormalAmpersand.siHeader[FormalAmpersand.Box*FormalAmpersand.BoxHeader][UNI,TOT]
-    MEANING "The boxheader is the definition of the way the box is drawn on the screen."
+    RELATION FormalAmpersand.siHeader[FormalAmpersand.Box*FormalAmpersand.HTMLtemplateCall][UNI,TOT]
+    MEANING "The HTMLtemplateCall is the definition of the way the box is drawn on the screen."
     RELATION FormalAmpersand.siObjs[FormalAmpersand.Box*FormalAmpersand.BoxItem][INJ,SUR]
     MEANING "The (ordered) elements/items in the box."
     RELATION FormalAmpersand.isLink[FormalAmpersand.InterfaceRef*FormalAmpersand.InterfaceRef][PROP]

README.md

@@ -9,4 +9,4 @@ Check out the [release notes](https://github.com/AmpersandTarski/Ampersand/blob/
 
 ## Documentation
 
-Our [documentation](https://ampersandtarski.github.io/docs/Ampersand/) features full-text search and it contains all documentation of several repositories in a single place. We are still [working](https://github.com/AmpersandTarski/Ampersand/issues/1315) on structuring it.
+Our [documentation](https://ampersandtarski.github.io/) features full-text search and it contains all documentation of several repositories in a single place. We are still [working](https://github.com/AmpersandTarski/Ampersand/issues/1315) on structuring it.

ReleaseNotes.md

@@ -1,8 +1,12 @@
 # Release notes of Ampersand
 
+## Unreleased
+
+- [Issue #1482](https://github.com/AmpersandTarski/Ampersand/issues/1482) Fix technical debd from merging Ampersand 4 into Ampersand 5
+
 ## v5.2.2 (9 september 2024)
 
--- fixed an issue with the release: Executables are added to the artefacts again.
+- fixed an issue with the release: Executables are added to the artefacts again.
 
 ## v5.2.1 (6 september 2024)
 

src/Ampersand/ADL1.hs

@@ -57,7 +57,6 @@ import Ampersand.Core.AbstractSyntaxTree
     A_Context (..),
     A_RoleRule (..),
     BoxItem (..),
-    BoxTxt (..),
     Conjunct (..),
     ContextInfo (..),
     Cruds (..),
@@ -111,9 +110,9 @@ import Ampersand.Core.AbstractSyntaxTree
     (.|-.),
   )
 import Ampersand.Core.ParseTree
-  ( BoxHeader (..),
-    EnforceOperator (..),
+  ( EnforceOperator (..),
     FilePos (..),
+    HTMLtemplateCall (..),
     MetaData (..),
     Origin (..),
     PAtomPair (..),

src/Ampersand/ADL1/P2A_Converters.hs

@@ -572,8 +572,8 @@ pCtx2aCtx
           then pure givenType
           else mkTypeMismatchError o dcl sourceOrTarget givenType
 
-      pObjDefDisamb2aObjDef :: ContextInfo -> P_BoxItem (TermPrim, DisambPrim) -> Guarded BoxItem
-      pObjDefDisamb2aObjDef ci x = fmap fst (typecheckObjDef ci x)
+      pBoxItemDisamb2BoxItem :: ContextInfo -> P_BoxItem (TermPrim, DisambPrim) -> Guarded BoxItem
+      pBoxItemDisamb2BoxItem ci x = fmap fst (typecheckObjDef ci x)
 
       pViewDef2aViewDef :: ContextInfo -> P_ViewDef -> Guarded ViewDef
       pViewDef2aViewDef ci x = typecheckViewDef ci tpda
@@ -709,12 +709,11 @@ pCtx2aCtx
               box_txt = str
             } ->
               pure
-                ( BxTxt
-                    BoxTxt
-                      { boxPlainName = nm,
-                        boxpos = orig,
-                        boxtxt = str
-                      },
+                ( BxText
+                    { boxPlainName = nm,
+                      boxpos = orig,
+                      boxtxt = str
+                    },
                   True
                 )
 
@@ -848,8 +847,9 @@ pCtx2aCtx
                     }
                 )
               fn :: (BoxItem, Bool) -> Guarded BoxItem
-              fn (BxExpr e, p) = BxExpr <$> matchWith (e, p)
-              fn (BxTxt t, _) = pure $ BxTxt t
+              fn (boxitem, p) = case boxitem of
+                BxExpr {} -> BxExpr <$> matchWith (objE boxitem, p)
+                BxText {} -> pure boxitem
               mustBeObject :: A_Concept -> Guarded ()
               mustBeObject cpt = case representationOf ci cpt of
                 Object -> pure ()
@@ -901,7 +901,7 @@ pCtx2aCtx
 
       pIfc2aIfc :: ContextInfo -> (P_Interface, P_BoxItem (TermPrim, DisambPrim)) -> Guarded Interface
       pIfc2aIfc declMap (pIfc, objDisamb) =
-        build $ pObjDefDisamb2aObjDef declMap objDisamb
+        build $ pBoxItemDisamb2BoxItem declMap objDisamb
         where
           build :: Guarded BoxItem -> Guarded Interface
           build gb =
@@ -933,7 +933,7 @@ pCtx2aCtx
                             . pure
                             . mkInterfaceMustBeDefinedOnObject pIfc (target . objExpression $ o)
                             $ tt
-                    BxTxt _ -> fatal "Unexpected BxTxt" -- Interface should not have TXT only. it should have a term object.
+                    BxText {} -> fatal "Unexpected BxTxt" -- Interface should not have TXT only. it should have a term object.
           ttype :: A_Concept -> TType
           ttype = representationOf declMap
 
@@ -1130,13 +1130,13 @@ pCtx2aCtx
           pIdentSegment2IdentSegment :: P_IdentSegmnt (TermPrim, DisambPrim) -> Guarded IdentitySegment
           pIdentSegment2IdentSegment (P_IdentExp ojd) =
             do
-              ob <- pObjDefDisamb2aObjDef ci ojd
-              case ob of
-                BxExpr o ->
+              boxitem <- pBoxItemDisamb2BoxItem ci ojd
+              case boxitem of
+                BxExpr {objE = o} ->
                   case toList . findExact genLattice $ aConcToType (source $ objExpression o) `lJoin` aConcToType conc of
                     [] -> mustBeOrdered orig (Src, origin ojd, objExpression o) pidt
                     _ -> pure $ IdentityExp o {objExpression = addEpsilonLeft genLattice conc (objExpression o)}
-                BxTxt t -> fatal $ "TXT is not expected in IDENT statements. (" <> tshow (origin t) <> ")"
+                BxText {} -> fatal $ "TXT is not expected in IDENT statements. (" <> tshow (origin boxitem) <> ")"
       typeCheckPairView :: ContextInfo -> Origin -> Expression -> PairView (Term (TermPrim, DisambPrim)) -> Guarded (PairView Expression)
       typeCheckPairView ci o x (PairView lst) =
         PairView <$> traverse (typeCheckPairViewSeg ci o x) lst
@@ -1166,7 +1166,6 @@ pCtx2aCtx
                 { explPos = orig,
                   explObj = obj,
                   explMarkup = pMarkup2aMarkup deflangCtxt deffrmtCtxt pmarkup,
-                  explUserdefd = True,
                   explRefIds = refIds
                 }
           )

src/Ampersand/ADL1/PrettyPrinters.hs

@@ -324,7 +324,7 @@ instance Pretty (P_SubIfc TermPrim) where
     P_Box _ c bs -> boxSpec c <+> text "[" <> listOfBy (prettyObject (SubInterfaceKind 2)) bs <> text "]"
     P_InterfaceRef _ isLink nm -> text ((if isLink then "LINKTO " else "") ++ "INTERFACE") <~> nm
     where
-      boxSpec :: BoxHeader -> Doc
+      boxSpec :: HTMLtemplateCall -> Doc
       boxSpec x = text "BOX " <+> encloseSep (text " <") (text "> ") (text " ") items
         where
           items = (text . T.unpack . text1ToText . btType $ x) : (map prettyKey . btKeys $ x)

src/Ampersand/Classes/ConceptStructure.hs

@@ -144,9 +144,9 @@ instance ConceptStructure Signature where
 
 instance ConceptStructure BoxItem where
   concs (BxExpr obj) = concs obj
-  concs (BxTxt _) = Set.empty
+  concs BxText {} = Set.empty
   expressionsIn (BxExpr obj) = expressionsIn obj
-  expressionsIn (BxTxt _) = Set.empty
+  expressionsIn BxText {} = Set.empty
 
 instance ConceptStructure ObjectDef where
   concs obj = (Set.singleton . target . objExpression $ obj) `Set.union` concs (objmsub obj)

src/Ampersand/Core/A2P_Converters.hs

@@ -48,7 +48,7 @@ aCtx2pCtx ctx =
       ctx_vs = map aViewDef2pViewDef . ctxvs $ ctx,
       ctx_gs = map aClassify2pClassify . ctxgs $ ctx,
       ctx_ifcs = map aInterface2pInterface . ctxifcs $ ctx,
-      ctx_ps = mapMaybe aPurpose2pPurpose . ctxps $ ctx,
+      ctx_ps = map aPurpose2pPurpose . ctxps $ ctx,
       ctx_pops = map aPopulation2pPopulation . ctxpopus $ ctx,
       ctx_metas = ctxmetas ctx,
       ctx_enfs = map aEnforce2pEnforce . ctxEnforces $ ctx
@@ -88,7 +88,7 @@ aPattern2pPattern pat =
       pt_Reprs = ptrps pat,
       pt_ids = map aIdentityDef2pIdentityDef . ptids $ pat,
       pt_vds = map aViewDef2pViewDef . ptvds $ pat,
-      pt_xps = mapMaybe aPurpose2pPurpose . ptxps $ pat,
+      pt_xps = map aPurpose2pPurpose . ptxps $ pat,
       pt_pop = map aPopulation2pPopulation . ptups $ pat,
       pt_end = ptend pat,
       pt_enfs = map aEnforce2pEnforce . ptenfs $ pat
@@ -241,18 +241,14 @@ aConcept2pConcept cpt =
         { p_cptnm = name cpt
         }
 
-aPurpose2pPurpose :: Purpose -> Maybe PPurpose
+aPurpose2pPurpose :: Purpose -> PPurpose
 aPurpose2pPurpose p =
-  if explUserdefd p
-    then
-      Just
-        PPurpose
-          { pos = explPos p,
-            pexObj = aExplObj2PRef2Obj (explObj p),
-            pexMarkup = aMarkup2pMarkup (explMarkup p),
-            pexRefIDs = explRefIds p
-          }
-    else Nothing
+  PPurpose
+    { pos = explPos p,
+      pexObj = aExplObj2PRef2Obj (explObj p),
+      pexMarkup = aMarkup2pMarkup (explMarkup p),
+      pexRefIDs = explRefIds p
+    }
 
 aPopulation2pPopulation :: Population -> P_Population
 aPopulation2pPopulation p =
@@ -289,11 +285,11 @@ aObjectDef2pObjectDef x =
           obj_mView = objmView oDef,
           obj_msub = fmap aSubIfc2pSubIfc (objmsub oDef)
         }
-    BxTxt oDef ->
+    BxText {} ->
       P_BxTxt
-        { obj_PlainName = boxPlainName oDef,
-          pos = origin oDef,
-          box_txt = boxtxt oDef
+        { obj_PlainName = boxPlainName x,
+          pos = origin x,
+          box_txt = boxtxt x
         }
 
 aExpression2pTermPrim :: Expression -> Term TermPrim

src/Ampersand/Core/AbstractSyntaxTree.hs

@@ -35,7 +35,6 @@ module Ampersand.Core.AbstractSyntaxTree
     SubInterface (..),
     BoxItem (..),
     ObjectDef (..),
-    BoxTxt (..),
     Object (..),
     Cruds (..),
     Default (..),
@@ -92,9 +91,9 @@ where
 import Ampersand.ADL1.Lattices (Op1EqualitySystem)
 import Ampersand.Basics
 import Ampersand.Core.ParseTree
-  ( BoxHeader (..),
-    DefinitionContainer (..),
+  ( DefinitionContainer (..),
     EnforceOperator,
+    HTMLtemplateCall (..),
     MetaData (..),
     Origin (..),
     PAtomValue (..),
@@ -742,12 +741,17 @@ instance Object ObjectDef where
 
 data BoxItem
   = BxExpr {objE :: !ObjectDef}
-  | BxTxt {objT :: !BoxTxt}
-  deriving (Eq, Ord, Show)
+  | -- | view name of the object definition. The label has no meaning in the Compliant Service Layer, but is used in the generated user interface if it is not an empty string.
+    BxText
+      { boxPlainName :: !(Maybe Text1),
+        boxpos :: !Origin,
+        boxtxt :: !Text
+      }
+  deriving (Show)
 
 isObjExp :: BoxItem -> Bool
 isObjExp BxExpr {} = True
-isObjExp BxTxt {} = False
+isObjExp BxText {} = False
 
 instance Unique BoxItem where
   showUnique = showUniqueAsHash
@@ -756,31 +760,28 @@ instance Traced BoxItem where
   origin o =
     case o of
       BxExpr {} -> origin . objE $ o
-      BxTxt {} -> origin . objT $ o
-
-data BoxTxt = BoxTxt
-  { -- | view name of the object definition. The label has no meaning in the Compliant Service Layer, but is used in the generated user interface if it is not an empty string.
-    boxPlainName :: !(Maybe Text1),
-    boxpos :: !Origin,
-    boxtxt :: !Text
-  }
-  deriving (Show)
+      BxText {} -> boxpos o
 
-instance Ord BoxTxt where
-  compare a b = case compare (boxPlainName a, boxtxt a) (boxPlainName b, boxtxt b) of
-    EQ ->
-      fromMaybe
-        ( fatal
-            . T.intercalate "\n"
-            $ [ "BoxTxt should have a non-fuzzy Origin.",
-                tshow (origin a),
-                tshow (origin b)
-              ]
-        )
-        (maybeOrdering (origin a) (origin b))
-    x -> x
+instance Ord BoxItem where
+  compare a b =
+    case (a, b) of
+      (BxExpr {}, BxExpr {}) -> compare (objE a) (objE b)
+      (BxExpr {}, BxText {}) -> GT
+      (BxText {}, BxExpr {}) -> LT
+      (BxText {}, BxText {}) -> case compare (boxPlainName a, boxtxt a) (boxPlainName b, boxtxt b) of
+        EQ ->
+          fromMaybe
+            ( fatal
+                . T.intercalate "\n"
+                $ [ "BxText should have a non-fuzzy Origin.",
+                    tshow (origin a),
+                    tshow (origin b)
+                  ]
+            )
+            (maybeOrdering (origin a) (origin b))
+        x -> x
 
-instance Eq BoxTxt where
+instance Eq BoxItem where
   a == b = compare a b == EQ
 
 data ObjectDef = ObjectDef
@@ -823,9 +824,6 @@ instance Ord ObjectDef where
 instance Eq ObjectDef where
   a == b = compare a b == EQ
 
-instance Traced BoxTxt where
-  origin = boxpos
-
 data Cruds = Cruds
   { crudOrig :: !Origin,
     crudC :: !Bool,
@@ -848,7 +846,7 @@ data SubInterface
   = Box
       { pos :: !Origin,
         siConcept :: !A_Concept,
-        siHeader :: !BoxHeader,
+        siHeader :: !HTMLtemplateCall,
         siObjs :: ![BoxItem]
       }
   | InterfaceRef
@@ -885,8 +883,6 @@ data Purpose = Expl
     explObj :: !ExplObj,
     -- | This field contains the text of the explanation including language and markup info.
     explMarkup :: !Markup,
-    -- | Is this purpose defined in the script?
-    explUserdefd :: !Bool,
     -- | The references of the explaination
     explRefIds :: ![Text]
   }

src/Ampersand/Core/ParseTree.hs

@@ -22,7 +22,7 @@ module Ampersand.Core.ParseTree
     PairViewSegment (..),
     PairViewTerm (..),
     PairViewSegmentTerm (..),
-    BoxHeader (..),
+    HTMLtemplateCall (..),
     TemplateKeyValue (..),
     SrcOrTgt (..),
     DefinitionContainer (..),
@@ -934,7 +934,7 @@ type P_SubInterface = P_SubIfc TermPrim
 data P_SubIfc a
   = P_Box
       { pos :: !Origin,
-        si_header :: !BoxHeader,
+        si_header :: !HTMLtemplateCall,
         si_box :: [P_BoxItem a]
       }
   | P_InterfaceRef
@@ -945,7 +945,7 @@ data P_SubIfc a
   deriving (Show)
 
 -- | Key-value pairs used to supply attributes into an HTML template that is used to render a subinterface
-data BoxHeader = BoxHeader
+data HTMLtemplateCall = HTMLtemplateCall
   { pos :: !Origin,
     -- | Type of the HTML template that is used for rendering
     btType :: !Text1,
@@ -954,17 +954,17 @@ data BoxHeader = BoxHeader
   }
   deriving (Show, Data)
 
-instance Ord BoxHeader where
+instance Ord HTMLtemplateCall where
   compare a b = compare (btType a, L.sort (btKeys a)) (btType b, L.sort (btKeys b))
 
-instance Eq BoxHeader where
+instance Eq HTMLtemplateCall where
   a == b = compare a b == EQ
 
-instance Unique BoxHeader where
+instance Unique HTMLtemplateCall where
   showUnique x = btType x T1.<>. (T.concat . fmap (text1ToText . showUnique) . L.sort . btKeys $ x)
 
-instance Traced BoxHeader where
-  origin BoxHeader {pos = orig} = orig
+instance Traced HTMLtemplateCall where
+  origin HTMLtemplateCall {pos = orig} = orig
 
 data TemplateKeyValue = TemplateKeyValue
   { pos :: !Origin,

src/Ampersand/FSpec/Crud.hs

@@ -110,7 +110,7 @@ getAllInterfaceExprs allIfcs ifc = getExprs $ ifcObj ifc
             where
               referencedInterface = fullName . siIfcId $ si
               getExprs' (BxExpr e) = getExprs e
-              getExprs' (BxTxt _) = []
+              getExprs' BxText {} = []
 
 getCrudObjsPerConcept ::
   [(Interface, [(A_Concept, Bool, Bool, Bool, Bool)])] ->