From 9ad26842c59bc85845fbcaaa5bdddda694f3b7a3 Mon Sep 17 00:00:00 2001 From: Stef Joosten Date: Thu, 12 Oct 2023 21:25:03 +0200 Subject: [PATCH 01/16] Use rule labels in ChapterNatLangReqs --- src/Ampersand/Basics/Name.hs | 2 +- .../Output/ToPandoc/ChapterNatLangReqs.hs | 3 +- .../Output/ToPandoc/SharedAmongChapters.hs | 4 +- testing/Travis/testcases/Misc/Arbeidsduur.adl | 121 ++++++++++-------- 4 files changed, 70 insertions(+), 60 deletions(-) diff --git a/src/Ampersand/Basics/Name.hs b/src/Ampersand/Basics/Name.hs index ab32cab26..b664d4a82 100644 --- a/src/Ampersand/Basics/Name.hs +++ b/src/Ampersand/Basics/Name.hs @@ -198,7 +198,7 @@ class Named a => Labeled a where Just (Label lbl) -> lbl instance Show Label where - show (Label x) = "LABEL " <> T.unpack x + show (Label x) = T.unpack x prependToPlainName :: Text -> Name -> Name prependToPlainName t nm = diff --git a/src/Ampersand/Output/ToPandoc/ChapterNatLangReqs.hs b/src/Ampersand/Output/ToPandoc/ChapterNatLangReqs.hs index 7228850fd..e26e83aeb 100644 --- a/src/Ampersand/Output/ToPandoc/ChapterNatLangReqs.hs +++ b/src/Ampersand/Output/ToPandoc/ChapterNatLangReqs.hs @@ -218,8 +218,7 @@ chpNatLangReqs env lev fSpec = [ ( str (l (NL "Afspraak ", EN "Agreement ")) <> (text . tshow . theNr $ nRul) <> ": " - <> xDefInln env fSpec (XRefSharedLangRule rul) - <> ".", + <> xDefInln env fSpec (XRefSharedLangRule rul), case (cRulMeanings . theLoad) nRul of [] -> [ plain $ diff --git a/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs b/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs index 12e11d1d6..018e1714d 100644 --- a/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs +++ b/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs @@ -86,7 +86,7 @@ class Typeable a => Xreferenceable a where xDefInln :: (HasOutputLanguage env) => env -> FSpec -> a -> Inlines xDefInln _ _ a = fatal ("A " <> tshow (typeOf a) <> " cannot be labeled in an .") --you should use xDefBlck instead. - -- ^ function that defines the target Inlines of something that can e referenced. + -- ^ function that defines the target Inlines of something that can be referenced. hyperLinkTo :: a -> Inlines -- ^ function that returns a link to something that can be referenced. @@ -133,7 +133,7 @@ hyperTarget env fSpec a = -- ("", ["adl"],[("caption",tshow d)]) -- ( "Deze RELATIE moet nog verder worden uitgewerkt in de Haskell code") -- ) - XRefSharedLangRule r -> Right $ spanWith (xSafeLabel a, [], []) (str . tshow . name $ r) + XRefSharedLangRule r -> (Right . spanWith (xSafeLabel a, [], []) . str . label) r -- Left $ divWith (xSafeLabel a,[],[]) -- ( (para . text $ tshow r) -- -- <>codeBlockWith diff --git a/testing/Travis/testcases/Misc/Arbeidsduur.adl b/testing/Travis/testcases/Misc/Arbeidsduur.adl index a64f2ea48..b7f7f2788 100644 --- a/testing/Travis/testcases/Misc/Arbeidsduur.adl +++ b/testing/Travis/testcases/Misc/Arbeidsduur.adl @@ -1,4 +1,4 @@ -CONTEXT Arbeidsduur IN DUTCH LATEX +CONTEXT Arbeidsduur IN DUTCH MARKDOWN META "authors" "Stef Joosten, Rieks Joosten" PURPOSE CONTEXT Arbeidsduur {+De Wet aanpassing arbeidsduur (http://wetten.overheid.nl/BWBR0011173, 19 februari 2000) regelt het recht van werknemers om te vragen om aanpassing van de arbeidsduur. Op deze wet is een Ampersand analyse gedaan, om inzicht te krijgen in de wijze van modelleren aan de hand van een klein voorbeeld. Daar waar in deze tekst wordt gerefereerd naar een wetsartikel, zonder de naam van de wet erbij te noemen, wordt de Wet aanpassing arbeidsduur bedoeld.+} @@ -142,7 +142,8 @@ PURPOSE RELATION omvang REF "Artikel 2 lid 3" PURPOSE RULE EenJaarInDienst REF "Artikel 2 lid 1" {+Omdat werknemers niet direct na indiensttreding een verzoek tot aanpassing mogen doen, geldt in de wet een termijn van een jaar na indiensttreding.+} -RULE EenJaarInDienst : arbeidsrelatie~;tot;ingang;(I /\ minstensEenJaar~;minstensEenJaar) |- inDienst;minstensEenJaar +RULE EenJaarInDienst LABEL "Een jaar in dienst": + arbeidsrelatie~;tot;ingang;(I /\ minstensEenJaar~;minstensEenJaar) |- inDienst;minstensEenJaar -- Deze regel geeft alleen overtredingen als 'minstensEenJaar' al is uitgerekend, en laat bovendien toe dat 'TGT I' in onderstaande 'VIOLATION' kan worden gebruikt. MEANING "De werknemer, die een verzoek indient, dient ten minste een jaar voorafgaand aan het beoogde tijdstip van ingang van die aanpassing in dienst te zijn bij die werkgever." MESSAGE "Wet op Aanpassing van de Arbeidsduur, Artikel 2 lid 1:" @@ -150,17 +151,20 @@ VIOLATION (SRC werknemer, TXT " is minder dan een jaar voorafgaand aan ingangsti PURPOSE RULE TijdigIndienen REF "Artikel 2 lid 3" {+Omdat werkgevers voldoende tijd moeten krijgen voor het beslissen, schrijft de wet voor dat een aanvraag vier maanden voor de beoogde ingangsdatum van de aanpassing moet worden ingediend.+} -RULE TijdigIndienen : tot;ingang;vierMaandenOfMeer~ |- ingediend +RULE TijdigIndienen LABEL "Tijdig indienen": + tot;ingang;vierMaandenOfMeer~ |- ingediend MEANING "Deze regel bewaakt dat er minstens vier maanden zijn verstreken tussen het tijdstip van aanvragen en het tijdstip van ingang van de aanpassing." MESSAGE "Wet op Aanpassing van de Arbeidsduur, Artikel 2 lid 3" VIOLATION (TXT "Het ", SRC I, TXT " is later dan vier maanden voor de ingangsdatum (", SRC tot;ingang, TXT ") ingediend.") -RULE IndieningsmogelijkhedenBeperkenTotTweeJaar: minstensTweeJaarTrigger /\ beslisdatum~;op;isDirecteVoorloperVan;(I[Verzoek] /\ laatsteVerzoek~;laatsteVerzoek);ingediend |- minstensTweeJaar +RULE IndieningsmogelijkhedenBeperkenTotTweeJaar LABEL "Indieningsmogelijkheden beperken tot twee jaar": + minstensTweeJaarTrigger /\ beslisdatum~;op;isDirecteVoorloperVan;(I[Verzoek] /\ laatsteVerzoek~;laatsteVerzoek);ingediend |- minstensTweeJaar MEANING "De werknemer kan ten hoogste eenmaal per twee jaren, nadat de werkgever een verzoek om aanpassing van de arbeidsduur heeft ingewilligd of afgewezen, opnieuw een verzoek indienen" PURPOSE RULE IndieningsmogelijkhedenBeperkenTotTweeJaar REF "Artikel 2 lid 3" {+De wet zegt: 'De werknemer kan ten hoogste eenmaal per twee jaren, nadat de werkgever een verzoek om aanpassing van de arbeidsduur heeft ingewilligd of afgewezen, opnieuw een verzoek indienen'. Daarom moet een regel bestaan die dit afdwingt.+} -RULE AlleenOpHetLaatsteVerzoekBesluiten: arbeidsrelatie~ /\ -laatsteVerzoek |- arbeidsrelatie~;(I /\ op~;op) +RULE AlleenOpHetLaatsteVerzoekBesluiten LABEL "Alleen op het laatste verzoek besluiten": + arbeidsrelatie~ /\ -laatsteVerzoek |- arbeidsrelatie~;(I /\ op~;op) MEANING "Per arbeidsrelatie mag hoogstens een verzoek bestaan waarover (nog) niet besloten is." PURPOSE RULE AlleenOpHetLaatsteVerzoekBesluiten REF "Artikel 2 lid 3" {+Omdat de wet stelt dat een werknemer hooguit eenmaal per twee jaren om een aanpassing van de arbeidsduur kan verzoeken, kan er op elk tijdstip en per arbeidsrelatie hoogstens een verzoek bestaan waarop nog niet is besloten. Dat is dan dus tevens het laatste verzoek. Deze eigenschap maakt het mogelijk om eenduidig een opeenvolging van verzoeken per arbeidsrelatie te maken.+} @@ -180,7 +184,8 @@ PATTERN VerzoekBehandelen ROLE Werkgever MAINTAINS BeslissenOverVerzoek PURPOSE RULE BeslissenOverVerzoek REF "Artikel 2 lid 10" {+De wet stelt dat indien de werkgever niet een maand voor het beoogde tijdstip van ingang van de aanpassing op het verzoek heeft beslist, de arbeidsduur wordt aangepast overeenkomstig het verzoek van de werknemer. Daarom moet op elk verzoek tijdig een besluit worden genomen.+} -RULE BeslissenOverVerzoek : arbeidsrelatie;werkgever |- op~;door +RULE BeslissenOverVerzoek LABEL "Beslissen over verzoek": + arbeidsrelatie;werkgever |- op~;door MEANING "Degene aan wie een verzoek gericht is dient daarop (tijdig!) een beslissing te nemen." MESSAGE "Nog beslissen:" VIOLATION (TGT I, TXT " moet voor ", SRC uitersteBeslisdatum, TXT " beslissen over ", SRC I, TXT ".") @@ -188,7 +193,8 @@ VIOLATION (TGT I, TXT " moet voor ", SRC uitersteBeslisdatum, TXT " beslissen ov ROLE Werkgever MAINTAINS BeslissingMededelen PURPOSE RULE BeslissingMededelen REF "Artikel 2 lid 7" {+De beslissing op het verzoek om aanpassing van de arbeidsduur wordt door de werkgever schriftelijk aan de werknemer meegedeeld.+} -RULE BeslissingMededelen : op |- medegedeeldAan;werknemer~;arbeidsrelatie~ +RULE BeslissingMededelen LABEL "Beslissing mededelen": + op |- medegedeeldAan;werknemer~;arbeidsrelatie~ MEANING "De beslissing op een verzoek dient medegedeeld te worden aan de werknemer" MESSAGE "Nog te verzenden besluiten:" VIOLATION (TXT "verzoek van ", SRC op;arbeidsrelatie;werknemer, TXT ", die op ", SRC aanp[Beslissing*Aanpassing];ingang, TXT " in effect treedt.") @@ -196,7 +202,8 @@ VIOLATION (TXT "verzoek van ", SRC op;arbeidsrelatie;werknemer, TXT ", die op ", PURPOSE RULE VerzoekGemotiveerdAfwijzen REF "Artikel 2 lid 7" {+Indien de werkgever het verzoek niet inwilligt of de spreiding van de uren vaststelt in afwijking van de wensen van de werknemer, wordt dit onder schriftelijke opgave van de redenen meegedeeld. Hieruit valt op te maken dat elke afwijkende arbeidsduur vraagt om opgave van redenen.+} -RULE VerzoekGemotiveerdAfwijzen : I /\ op;tot;-I;aanp~ |- reden;reden~ +RULE VerzoekGemotiveerdAfwijzen LABEL "Verzoek gemotiveerd afwijzen": + I /\ op;tot;-I;aanp~ |- reden;reden~ MEANING "Wanneer de arbeidsduur uit de beslissing afwijkt van de arbeidsduur uit het verzoek, dan dient er een reden voor te zijn, die in de beslissing wordt opgenomen." MESSAGE "Artikel 2 lid 7 Wet aanpassing arbeidsduur eist dat als de besloten arbeidsduur afwijkt van hetgeen is verzocht, dit met (schriftelijke) redenen omkleed moet zijn." VIOLATION (TXT "Beslissing van ", SRC door, TXT ", op ", SRC op, TXT " vereist een opgave van de reden(en).") @@ -210,13 +217,15 @@ PURPOSE PATTERN RekenenMetDatums PURPOSE RULE VandaagIsEenEnkeleDag {+ Om handelingen op een zekere datum uit te kunnen voeren, en omdat we dat in Ampersand moeten kunnen berekenen, voeren we een Concept ``Vandaag'' in (bestaande uit 1 atoom "vandaag").+} -RULE VandaagIsEenEnkeleDag: I[Vandaag] = "VANDAAG" +RULE VandaagIsEenEnkeleDag LABEL "Vandaag is een enkele dag": + I[Vandaag] = "VANDAAG" vandaag :: Vandaag * Datum [UNI] PRAGMA "" "is de datum" POPULATION Vandaag CONTAINS ["VANDAAG"] ROLE ExecEngine MAINTAINS StelDatumVanVandaagVast -RULE StelDatumVanVandaagVast: I[Vandaag] |- vandaag;vandaag~ +RULE StelDatumVanVandaagVast LABEL "Stel datum van vandaag vast": + I[Vandaag] |- vandaag;vandaag~ VIOLATION (TXT "{EX} SetToday;vandaag;Vandaag;VANDAAG;Datum") PURPOSE RELATION datumEQV @@ -235,7 +244,8 @@ datumGD :: Datum * Datum MEANING "De relatie 'datumGD' geeft van elk paar datums weer welke groter dan of gelijk is aan de ander." ROLE ExecEngine MAINTAINS DatumgerelateerdeRelatiesBerekenen -RULE DatumgerelateerdeRelatiesBerekenen: V[Datum] |- datumEQV \/ datumNEQ +RULE DatumgerelateerdeRelatiesBerekenen LABEL "Datumgerelateerde relaties berekenen": + V[Datum] |- datumEQV \/ datumNEQ VIOLATION (TXT "{EX} datimeEQL;datumEQV;Datum;", SRC I, TXT ";", TGT I ,TXT "{EX} datimeNEQ;datumNEQ;Datum;", SRC I, TXT ";", TGT I -- ,TXT "{EX} datimeLT;datumKD;Datum;", SRC I, TXT ";", TGT I @@ -247,11 +257,18 @@ ENDPATTERN --[Proces: geautomatiseerde procesondersteuning]----------- PATTERN GeautomatiseerdeProcesondersteuning PURPOSE PATTERN GeautomatiseerdeProcesondersteuning -{+Menselijke procesuitvoerders moeten zoveel mogelijk worden ontlast van handelingen die ook geautomatiseerd kunnen worden uitgevoerd. Geautomatiseerde procesondersteuning zorgt ervoor dat informatie die reeds aanwezig is dan wel afleidbaar is uit bestaande informatie, daar waar nodig automatisch wordt ingevuld. Ook zorgt het ervoor dat handelingen automatisch uitgevoerd worden voor zover dit afleidbaar is. Dit hoofdstuk documenteert de afspraken op basis waarvan automatische handelingen worden uitgevoerd.+} +{+ +Menselijke procesuitvoerders moeten zoveel mogelijk worden ontlast van handelingen die ook geautomatiseerd kunnen worden uitgevoerd. +Geautomatiseerde procesondersteuning zorgt ervoor dat informatie die reeds aanwezig is dan wel afleidbaar is uit bestaande informatie, +daar waar nodig automatisch wordt ingevuld. +Ook zorgt het ervoor dat handelingen automatisch uitgevoerd worden voor zover dit afleidbaar is. +Dit hoofdstuk documenteert de afspraken op basis waarvan automatische handelingen worden uitgevoerd. ++} nieuwVerzoek :: Arbeidsrelatie * Verzoek [UNI] ROLE ExecEngine MAINTAINS EersteVerzoekVerwerken -RULE EersteVerzoekVerwerken: (I /\ -(laatsteVerzoek;laatsteVerzoek~));nieuwVerzoek |- -nieuwVerzoek +RULE EersteVerzoekVerwerken LABEL "Eerste verzoek verwerken": + (I /\ -(laatsteVerzoek;laatsteVerzoek~));nieuwVerzoek |- -nieuwVerzoek MEANING "Elk (eerste) verzoek moet worden verwerkt" VIOLATION (TXT "{EX} InsPair;laatsteVerzoek;Arbeidsrelatie;", SRC I, TXT ";Verzoek;", TGT I ,TXT "{EX} InsPair;arbeidsrelatie;Verzoek;", TGT I, TXT ";Arbeidsrelatie;", SRC I @@ -259,7 +276,8 @@ VIOLATION (TXT "{EX} InsPair;laatsteVerzoek;Arbeidsrelatie;", SRC I, TXT ";Verzo ) ROLE ExecEngine MAINTAINS OpeenvolgendeVerzoekenVerwerken -RULE OpeenvolgendeVerzoekenVerwerken: (I /\ laatsteVerzoek;laatsteVerzoek~);nieuwVerzoek |- -nieuwVerzoek +RULE OpeenvolgendeVerzoekenVerwerken LABEL "Opeenvolgende verzoeken verwerken": + (I /\ laatsteVerzoek;laatsteVerzoek~);nieuwVerzoek |- -nieuwVerzoek MEANING "Elk (volgend) verzoek moet worden verwerkt" VIOLATION (TXT "{EX} InsPair;isDirecteVoorloperVan;Verzoek;", SRC laatsteVerzoek, TXT ";Verzoek;", TGT I ,TXT "{EX} InsPair;laatsteVerzoek;Arbeidsrelatie;", SRC I, TXT ";Verzoek;", TGT I @@ -268,14 +286,16 @@ VIOLATION (TXT "{EX} InsPair;isDirecteVoorloperVan;Verzoek;", SRC laatsteVerzoek ) ROLE ExecEngine MAINTAINS ArbeidsrelatieGeautomatiseerdInvullen -RULE ArbeidsrelatieGeautomatiseerdInvullen: arbeidsrelatie;werknemer;(I[Persoon] /\ -(werknemer~;-I[Arbeidsrelatie];werknemer));werknemer~ |- arbeidsrelatie +RULE ArbeidsrelatieGeautomatiseerdInvullen LABEL "Arbeidsrelatie geautomatiseerd invullen": + arbeidsrelatie;werknemer;(I[Persoon] /\ -(werknemer~;-I[Arbeidsrelatie];werknemer));werknemer~ |- arbeidsrelatie MEANING "Als een werknemer die om aanpassing verzoekt slechts 1 arbeidsrelatie heeft, dan wordt deze zo nodig automatisch in het verzoek ingevuld." VIOLATION (TXT "{EX} InsPair;arbeidsrelatie;Verzoek;", SRC I, TXT ";Arbeidsrelatie;", TGT I) PURPOSE RULE ArbeidsrelatieGeautomatiseerdInvullen {+ Gebruikers hoeven de arbeidsrelatie in een verzoek niet in te vullen als deze kan worden afgeleid.+} ROLE ExecEngine MAINTAINS VerzoeksdatumGeautomatiseerdInvullen -RULE VerzoeksdatumGeautomatiseerdInvullen: (I[Verzoek] /\ -(ingediend;ingediend~));V;vandaag |- ingediend +RULE VerzoeksdatumGeautomatiseerdInvullen LABEL "Verzoeksdatum geautomatiseerd invullen": + (I[Verzoek] /\ -(ingediend;ingediend~));V;vandaag |- ingediend MEANING "Als de indieningsdatum van een verzoek niet is ingevuld, dan wordt daarvoor automatisch de datum van vandaag ingevuld." VIOLATION (TXT "{EX} InsPair;ingediend;Verzoek;", SRC I, TXT ";Datum;", TGT I) PURPOSE RULE VerzoeksdatumGeautomatiseerdInvullen REF "Artikel 2 lid 3" @@ -289,13 +309,15 @@ PRAGMA "" "ligt minstens vier maanden voor" MEANING "De relatie 'vierMaandenOfMeer' bevat alleen paren van datums waarvan de eerste minstens vier maanden voor de tweede valt." vierMaandenOfMeerTrigger :: Datum * Datum ROLE ExecEngine MAINTAINS BerekenVierMaandenOfMeer -RULE BerekenVierMaandenOfMeer: ingediend~;tot;ingang |- vierMaandenOfMeerTrigger +RULE BerekenVierMaandenOfMeer LABEL "Bereken vier maanden of meer": + ingediend~;tot;ingang |- vierMaandenOfMeerTrigger VIOLATION (TXT "{EX} InsPair;vierMaandenOfMeerTrigger;Datum;", SRC I, TXT ";Datum;", TGT I ,TXT "{EX} DatumDelta;vierMaandenOfMeer;Datum;", SRC I, TXT ";4 Months;", TGT I ) ROLE ExecEngine MAINTAINS UitersteBeslisdatumGeautomatiseerdInvullen -RULE UitersteBeslisdatumGeautomatiseerdInvullen: (I[Beslissing] /\ -(beslisdatum;beslisdatum~));V;vandaag |- beslisdatum +RULE UitersteBeslisdatumGeautomatiseerdInvullen LABEL "Uiterste beslisdatum geautomatiseerd invullen": + (I[Beslissing] /\ -(beslisdatum;beslisdatum~));V;vandaag |- beslisdatum MEANING "Als de beslisdatum van een beslissing niet is ingevuld, dan wordt daarvoor automatisch de datum van vandaag ingevuld." VIOLATION (TXT "{EX} InsPair;beslisdatum;Beslissing;", SRC I, TXT ";Datum;", TGT I) PURPOSE RULE UitersteBeslisdatumGeautomatiseerdInvullen REF "Artikel 2 lid 3" @@ -306,16 +328,19 @@ PURPOSE RELATION eenMaandVoordien REF "Artikel 2 lid 10" eenMaandVoordien :: Datum * Datum [INJ,UNI] MEANING "De relatie 'eenMaandVoordien' geeft van elke datum waarvoor dat nodig is, aan welke datum een maand voordien was." ROLE ExecEngine MAINTAINS BerekenEenMaandVoordien -RULE BerekenEenMaandVoordien: ingang[Aanpassing*Datum] |- ingang;(I /\ eenMaandVoordien;eenMaandVoordien~) +RULE BerekenEenMaandVoordien LABEL "Bereken een maand voordien": + ingang[Aanpassing*Datum] |- ingang;(I /\ eenMaandVoordien;eenMaandVoordien~) VIOLATION (TXT "{EX} SetPeriod;eenMaandVoordien;Datum;", TGT I, TXT ";-1 Month") ROLE ExecEngine MAINTAINS UitersteBeslisdatumGeautomatiseerdHerzien -RULE UitersteBeslisdatumGeautomatiseerdHerzien: uitersteBeslisdatum;datumEQV |- tot;ingang;eenMaandVoordien +RULE UitersteBeslisdatumGeautomatiseerdHerzien LABEL "Uiterste beslisdatum geautomatiseerd herzien": + uitersteBeslisdatum;datumEQV |- tot;ingang;eenMaandVoordien MEANING "Van elk verzoek wordt, zo nodig, de uiterste belisdatum automatisch herzien." VIOLATION (TXT "{EX} DelPair;uitersteBeslisdatum;Verzoek;", SRC I, TXT ";Datum;", TGT I) ROLE ExecEngine MAINTAINS UitersteBeslisdatumGeautomatiseerdVaststellen -RULE UitersteBeslisdatumGeautomatiseerdVaststellen: tot;ingang;eenMaandVoordien |- uitersteBeslisdatum;datumEQV +RULE UitersteBeslisdatumGeautomatiseerdVaststellen LABEL "Uiterste beslisdatum geautomatiseerd vaststellen": + tot;ingang;eenMaandVoordien |- uitersteBeslisdatum;datumEQV MEANING "Van elk verzoek wordt de uiterste belisdatum automatisch vastgesteld." VIOLATION (TXT "{EX} InsPair;uitersteBeslisdatum;Verzoek;", SRC I, TXT ";Datum;", TGT I) @@ -328,11 +353,12 @@ minstensEenJaarTrigger :: Datum * Datum PURPOSE RULE BerekenenTermijnEenJaar {+Artikel 2 lid 1 stelt dat voor de berekening van de termijn van een jaar, perioden waarin arbeid wordt verricht en die elkaar opvolgen met een onderbreking van niet meer dan drie maanden, worden samengeteld. Ook stelt dit artikel dat dit geldt als arbeid voor verschillende wergevers wordt verricht die ten aanzien van de verrichte arbeid redelijkerwijs geacht moeten worden elkanders opvolger te zijn. Er is voor gekozen om de bedoelde termijn van een jaar geautomatiseerd te berekenen voor zover deze uit een enkele arbeidsovereenkomst valt af te leiden.+} --! Om geheel aan art 2 lid 1 te voldoen moet dus nog een stukje handmatig proces worden gespecificeerd. !-- ROLE ExecEngine MAINTAINS BerekenenTermijnEenJaar -RULE BerekenenTermijnEenJaar: +RULE BerekenenTermijnEenJaar LABEL "Berekenen termijn een jaar": + inDienst~;arbeidsrelatie~;tot;ingang |- minstensEenJaarTrigger -VIOLATION (TXT "{EX} InsPair;minstensEenJaarTrigger;Datum;", SRC I, TXT ";Datum;", TGT I - ,TXT "{EX} DatumDelta;minstensEenJaar;Datum;", SRC I, TXT ";1 Year;", TGT I +VIOLATION (TXT "{EX} DatumDelta;minstensEenJaar;Datum;", SRC I, TXT ";1 Year;", TGT I ) +ENFORCE minstensEenJaarTrigger >: inDienst~;arbeidsrelatie~;tot;ingang PURPOSE RELATION minstensTweeJaar REF "Artikel 2 lid 3" {+Omdat de wet de voorwaarde stelt dat de werknemer die tot aanpassing van zijn arbeidsduur verzoekt, tenminste 2 jaar na een voorafgaand besluit wacht met het indienen van een nieuw verzoek, willen we dat automatisch kunnen uitrekenen. Daarom voeren we een relatie ``minstensTweeJaar'' in.+} @@ -343,14 +369,16 @@ minstensTweeJaarTrigger :: Datum * Datum PURPOSE RULE BerekenenVanDeTermijnVanTweeJaar {+Artikel 2 lid 3 stelt dat een werknemer ten hoogste eenmaal per twee jaren, nadat de werkgever een verzoek om aanpassing van de arbeidsduur heeft ingewilligd of afgewezen, opnieuw een verzoek kan indienen.+} ROLE ExecEngine MAINTAINS BerekenenVanDeTermijnVanTweeJaar -RULE BerekenenVanDeTermijnVanTweeJaar: +RULE BerekenenVanDeTermijnVanTweeJaar LABEL " Berekenen van de termijn van twee jaar": + beslisdatum~;op;isDirecteVoorloperVan~;ingediend |- minstensTweeJaarTrigger VIOLATION (TXT "{EX} InsPair;minstensTweeJaarTrigger;Datum;", SRC I, TXT ";Datum;", TGT I ,TXT "{EX} DatumDelta;minstensTweeJaar;Datum;", SRC I, TXT ";2 Years;", TGT I ) ROLE ExecEngine MAINTAINS GeautomatiseerdBeslissenOpEenVerzoek -RULE GeautomatiseerdBeslissenOpEenVerzoek: I[Verzoek] /\ uitersteBeslisdatum;datumGD~;vandaag~;V /\ -(op~;op) |- op~;I[Beslissing];op +RULE GeautomatiseerdBeslissenOpEenVerzoek LABEL "Geautomatiseerd beslissen op een verzoek": + I[Verzoek] /\ uitersteBeslisdatum;datumGD~;vandaag~;V /\ -(op~;op) |- op~;I[Beslissing];op MEANING "Voor elk verzoek waarvan de uiterste beslisdatum is verstreken, en waarop geen beslissing is genomen, wordt - conform de wet - automatisch besloten dat de arbeidsduur wordt aangepast overeenkomstig dat verzoek." VIOLATION (TXT "{EX} NewStruct;Beslissing" ,TXT ";op;Beslissing;NULL;Verzoek;", SRC I @@ -364,7 +392,8 @@ PURPOSE RULE GeautomatiseerdBeslissenOpEenVerzoek REF "Artikel 2 lid 10" {+De wet stelt dat indien de werkgever niet een maand voor het beoogde tijdstip van ingang van de aanpassing op het verzoek heeft beslist, de arbeidsduur wordt aangepast overeenkomstig het verzoek van de werknemer. Een dergelijk besluit kan geautomatiseerd worden genomen en verstuurd.+} ROLE ExecEngine MAINTAINS GeautomatiseerdEffectuerenVanBeslissingen -RULE GeautomatiseerdEffectuerenVanBeslissingen: laatsteVerzoek;op~;aanp;nieuw |- arbeidsduur +RULE GeautomatiseerdEffectuerenVanBeslissingen LABEL "Geautomatiseerd effectueren van beslissingen": + laatsteVerzoek;op~;aanp;nieuw |- arbeidsduur MEANING "Een beslissing tot aanpassing van de arbeidsduur moet worden ge-effectueerd in de arbeidsrelatie." VIOLATION (TXT "{EX} InsPair;arbeidsduur;Arbeidsrelatie;", SRC I, TXT ";Arbeidsduur;", TGT I) PURPOSE RULE GeautomatiseerdEffectuerenVanBeslissingen @@ -414,7 +443,8 @@ BOX[ "Arbeidsrelaties" : V[ONE*Arbeidsrelatie] ----------------------------------------------- -} ] -INTERFACE NieuweArbeidsrelatie FOR Werkgever : I[Arbeidsrelatie] +INTERFACE NieuweArbeidsrelatie LABEL "NieuweArbeidsrelatie" + FOR Werkgever : I[Arbeidsrelatie] BOX[ "Werkgever" : werkgever , "Werknemer" : werknemer , "Arbeidsduur" : arbeidsduur @@ -431,7 +461,8 @@ BOX[ "Arbeidsrelatie" : I ] ] -INTERFACE ArbeidsrelatieWerknemer FOR Werknemer : I[Arbeidsrelatie] +INTERFACE ArbeidsrelatieWerknemer LABEL "ArbeidsrelatieWerknemer" + FOR Werknemer : I[Arbeidsrelatie] BOX[ "Arbeidsrelatie" : I BOX[ "Werkgever" : werkgever , "Werknemer" : werknemer @@ -453,7 +484,8 @@ BOX[ "Arbeidsrelatie" : I ] ] -INTERFACE GewijzigdeBeslissingNemen FOR Werkgever : I[Verzoek] +INTERFACE GewijzigdeBeslissingNemen LABEL "GewijzigdeBeslissingNemen" + FOR Werkgever : I[Verzoek] BOX[ "Verzoek" : I BOX[ "indiener" : arbeidsrelatie;werknemer , "werkgever" : arbeidsrelatie;werkgever @@ -474,7 +506,8 @@ BOX[ "Verzoek" : I ] ] -INTERFACE VoorstelOngewijzigdAccorderen FOR Werkgever : I[Verzoek] +INTERFACE VoorstelOngewijzigdAccorderen LABEL "VoorstelOngewijzigdAccorderen " + FOR Werkgever : I[Verzoek] BOX[ "Verzoek" : I BOX[ "indiener" : arbeidsrelatie;werknemer , "werkgever" : arbeidsrelatie;werkgever @@ -538,7 +571,8 @@ BOX[ "tot" : tot , "uitersteBeslisdatum" : uitersteBeslisdatum ] -INTERFACE BeslissingKlein FOR Werknemer, Werkgever : I[Beslissing] +INTERFACE BeslissingKlein LABEL "BeslissingKlein" + FOR Werknemer, Werkgever : I[Beslissing] BOX[ "op" : op , "aanp" : aanp , "door" : door @@ -689,26 +723,3 @@ POPULATION medegedeeldAan CONTAINS [ ("Beslissing b342", "Willem Alexander" ----------------------------------------------------------------------- ENDCONTEXT - -{- -[{EE} restored 'Bereken een maand voordien'] -Rule 'Bereken een maand voordien' is broken: -SetPeriod;eenMaandVoordien;Datum;1-1-2015;-1 Month -SetPeriod: InsPair(eenMaandVoordien,Datum,1-1-2015,Datum,01-12-2014) - Update eenMaandVoordien(Datum*Datum) with (1-1-2015,01-12-2014) - -{EE} restored 'Uiterste beslisdatum vaststellen (geautomatiseerd)'] -Rule 'Uiterste beslisdatum vaststellen (geautomatiseerd)' is broken: Van elk verzoek wordt de uiterste belisdatum automatisch vastgesteld. -InsPair;uitersteBeslisdatum;Verzoek;Verzoek1399448850678000;Datum;01-12-2014 - Update uitersteBeslisdatum(Verzoek*Datum) with (Verzoek1399448850678000,01-12-2014) - -[{EE} restored 'Berekenen van de jaar-termijn conform artikel 2 lid 1'] -Rule 'Berekenen van de jaar-termijn conform artikel 2 lid 1' is broken: -[[START]] -InsPair;minstensEenJaarTrigger;Datum;1-2-2013;Datum;1-1-2015 - INSERT minstensEenJaarTrigger(Datum*Datum) with (1-2-2013,1-1-2015) -DatumDelta;minstensEenJaar;Datum;1-2-2013;1 Year;1-1-2015 -DatumDelta: InsPair(minstensEenJaar,Datum,1-2-2013,Datum,1-1-2015) - INSERT minstensEenJaar(Datum*Datum) with (1-2-2013,1-1-2015) -[[DONE]] --} \ No newline at end of file From 3c1d8edd34e2da09ff5dfe80e1a01fae8809a6e2 Mon Sep 17 00:00:00 2001 From: Stef Joosten Date: Thu, 12 Oct 2023 21:34:35 +0200 Subject: [PATCH 02/16] use pattern labels in generated documentation --- src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs | 2 +- testing/Travis/testcases/Misc/Arbeidsduur.adl | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs b/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs index 018e1714d..7ef1647e3 100644 --- a/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs +++ b/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs @@ -124,7 +124,7 @@ hyperTarget :: (HasOutputLanguage env) => env -> FSpec -> CustomSection -> Eithe hyperTarget env fSpec a = case a of XRefConceptualAnalysisPattern {} -> Left . hdr $ (text . l) (NL "Thema: ", EN "Theme: ") <> (singleQuoted . str . tshow . mkId . refStuff $ a) - XRefSharedLangTheme (Just pat) -> (Left . hdr . text . text1ToText . tName) pat + XRefSharedLangTheme (Just pat) -> (Left . hdr . text . label) pat XRefSharedLangTheme Nothing -> (Left . hdr . text . l) (NL "Overig", EN "Remaining") XRefSharedLangRelation d -> Right $ spanWith (xSafeLabel a, [], []) (str . tshow $ d) -- Left $ divWith (xSafeLabel a,[],[]) diff --git a/testing/Travis/testcases/Misc/Arbeidsduur.adl b/testing/Travis/testcases/Misc/Arbeidsduur.adl index b7f7f2788..914467312 100644 --- a/testing/Travis/testcases/Misc/Arbeidsduur.adl +++ b/testing/Travis/testcases/Misc/Arbeidsduur.adl @@ -179,7 +179,7 @@ VIOLATION (TXT "Deze beslissing dient genomen te worden door", SRC arbeidsrelati ENDPATTERN --[Proces: Verzoek behandelen]----------------------------- -PATTERN VerzoekBehandelen +PATTERN VerzoekBehandelen LABEL "Verzoek behandelen" ROLE Werkgever MAINTAINS BeslissenOverVerzoek PURPOSE RULE BeslissenOverVerzoek REF "Artikel 2 lid 10" @@ -211,7 +211,7 @@ VIOLATION (TXT "Beslissing van ", SRC door, TXT ", op ", SRC op, TXT " vereist e ENDPATTERN --[Proces: Rekenen met datums]----------------------------- -PATTERN RekenenMetDatums +PATTERN RekenenMetDatums LABEL "Rekenen met datums" PURPOSE PATTERN RekenenMetDatums {+De wet spreekt over tijdsverschillen van minstens vier maanden, of minstens een jaar. Dat vereist het kunnen rekenen met tijden. Omdat Ampersand dat nog niet goed kan, is een proces gedefinieerd dat deze berekeningen uitvoert. Dit proces is hier verder niet gedocumenteerd.+} @@ -255,7 +255,7 @@ VIOLATION (TXT "{EX} datimeEQL;datumEQV;Datum;", SRC I, TXT ";", TGT I ENDPATTERN --[Proces: geautomatiseerde procesondersteuning]----------- -PATTERN GeautomatiseerdeProcesondersteuning +PATTERN GeautomatiseerdeProcesondersteuning LABEL "Geautomatiseerde procesondersteuning" PURPOSE PATTERN GeautomatiseerdeProcesondersteuning {+ Menselijke procesuitvoerders moeten zoveel mogelijk worden ontlast van handelingen die ook geautomatiseerd kunnen worden uitgevoerd. From b125d6a055dc0d40155e8134b62dcdf0eb172a7c Mon Sep 17 00:00:00 2001 From: Stef Joosten Date: Thu, 12 Oct 2023 22:12:06 +0200 Subject: [PATCH 03/16] use labels in the Diagnosis chapter --- .../Output/ToPandoc/ChapterDiagnosis.hs | 32 +++++++++---------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs b/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs index 9aea7157c..e620abf43 100644 --- a/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs +++ b/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs @@ -112,7 +112,7 @@ chpDiagnosis env fSpec map (plain . str . text1ToText . tName . fst) (fRoles fSpec) ) -- Content rows: - [ (plain . str . text1ToText . tName) rul : + [ (plain . str . label) rul : [f rol rul | (rol, _) <- fRoles fSpec] | rul <- sigs ] @@ -138,7 +138,7 @@ chpDiagnosis env fSpec ( NL "Het oogmerk (purpose) van concept ", EN "The concept " ) - <> (singleQuoted . str . text1ToText . tName) c + <> (singleQuoted . str . label) c <> (str . l) ( NL " is niet gedocumenteerd.", EN " remains without a purpose." @@ -150,7 +150,7 @@ chpDiagnosis env fSpec ( NL "Het oogmerk (purpose) van de concepten: ", EN "Concepts " ) - <> commaPandocAnd outputLang' (map (str . text1ToText . tName) xs) + <> commaPandocAnd outputLang' (map (str . label) xs) <> (str . l) ( NL " is niet gedocumenteerd.", EN " remain without a purpose." @@ -362,7 +362,7 @@ chpDiagnosis env fSpec ( NL " geeft een conceptueel diagram met alle relaties die gedeclareerd zijn in ", EN " shows a conceptual diagram with all relations declared in " ) - <> (singleQuoted . str . text1ToText . tName) pat + <> (singleQuoted . str . label) pat <> "." ) <> xDefBlck env fSpec pict @@ -444,7 +444,7 @@ chpDiagnosis env fSpec where formalizations rls = bulletList - [ para ((emph . str . text1ToText . tName) r <> " (" <> (str . tshow . origin) r <> ")") + [ para ((emph . str . label) r <> " (" <> (str . tshow . origin) r <> ")") <> (para . showMath . formalExpression) r <> (para . showPredLogic outputLang' . formalExpression) r | r <- rls @@ -488,7 +488,7 @@ chpDiagnosis env fSpec Relations -> --The user-defined relations of the pattern / fSpec Rules -> -- The user-defined rules of the pattern / fSpec [Blocks] - mkTableRowPat p = mkTableRow (text1ToText . tName $ p) (relsDefdIn p) (udefrules p) + mkTableRowPat p = mkTableRow (label p) (relsDefdIn p) (udefrules p) mkTableRow nm rels ruls = map (plain . str) @@ -530,7 +530,7 @@ chpDiagnosis env fSpec -- Rows: [ [(plain . str . text1ToText . tName) rol] <> [(plain . str . maybe "--" (text1ToText . tName) . rrpat) rul | multProcs] - <> [ (plain . str . text1ToText . tName) rul, + <> [ (plain . str . label) rul, (plain . str . maybe "--" (text1ToText . tName) . rrpat) rul ] | (rol, rul) <- fRoleRuls fSpec @@ -577,7 +577,7 @@ chpDiagnosis env fSpec -- Rows: [ map (plain . str) - [ (text1ToText . tName) r, + [ (label) r, (tshow . origin) r, (tshow . length) ps ] @@ -625,19 +625,19 @@ chpDiagnosis env fSpec -- else expls -- where expls = [Plain (block<>[Space]) | Means l econt<-rrxpl r, l==Just outputLang' || l==Nothing, Para block<-econt] quoterule :: Rule -> Inlines - quoterule = singleQuoted . str . text1ToText . tName + quoterule = singleQuoted . str . label oneviol :: Rule -> AAtomPair -> Inlines oneviol r p = if isEndo (formalExpression r) && apLeft p == apRight p then singleQuoted - ( (str . text1ToText . tName . source . formalExpression) r + ( (str . label . source . formalExpression) r <> (str . showValADL . apLeft) p ) else - "(" <> (str . text1ToText . tName . source . formalExpression) r <> (str . showValADL . apLeft) p + "(" <> (str . label . source . formalExpression) r <> (str . showValADL . apLeft) p <> ", " - <> (str . text1ToText . tName . target . formalExpression) r + <> (str . label . target . formalExpression) r <> (str . showValADL . apRight) p <> ")" popwork :: [(Rule, AAtomPairs)] @@ -676,7 +676,7 @@ chpDiagnosis env fSpec showViolatedRule (r, ps) = (para . emph) ( (str . l) (NL "Regel ", EN "Rule ") - <> (str . text1ToText . tName) r + <> (str . label) r ) <> para ( ( if isSignal fSpec r @@ -692,7 +692,7 @@ chpDiagnosis env fSpec <> (commaPandocOr outputLang' . map (str . text1ToText . tName) . rolesOf $ r) else (str . l) (NL "Overtredingen van invariant ", EN "Violations of invariant ") - <> (str . text1ToText . tName) r + <> (str . label) r ) -- Alignment: (replicate 1 (AlignLeft, 1)) @@ -731,7 +731,7 @@ chpDiagnosis env fSpec -- Alignment: [(AlignLeft, 1.0)] -- Header: - [(plain . str . text1ToText . tName . source . formalExpression) r] + [(plain . str . label . source . formalExpression) r] -- Data rows: [ [(plain . str . showValADL . apLeft) p] | p <- take 10 . toList $ ps --max 10 rows @@ -742,7 +742,7 @@ chpDiagnosis env fSpec -- Alignment: (replicate 2 (AlignLeft, 1 / 2)) -- Header: - [(plain . str . text1ToText . tName . source . formalExpression) r, (plain . str . text1ToText . tName . target . formalExpression) r] + [(plain . str . label . source . formalExpression) r, (plain . str . label . target . formalExpression) r] -- Data rows: [ [(plain . str . showValADL . apLeft) p, (plain . str . showValADL . apRight) p] | p <- take 10 . toList $ ps --max 10 rows From 7401004467107ef9ed63e4972b5c4dd455f8c4a0 Mon Sep 17 00:00:00 2001 From: Stef Joosten Date: Fri, 13 Oct 2023 07:59:30 +0200 Subject: [PATCH 04/16] use pattern labels i.o. names in generated docs --- src/Ampersand/ADL1/P2A_Converters.hs | 24 +++++++++---------- src/Ampersand/Core/AbstractSyntaxTree.hs | 18 +++++++------- .../Output/ToPandoc/ChapterDiagnosis.hs | 4 ++-- .../Output/ToPandoc/SharedAmongChapters.hs | 5 +--- 4 files changed, 24 insertions(+), 27 deletions(-) diff --git a/src/Ampersand/ADL1/P2A_Converters.hs b/src/Ampersand/ADL1/P2A_Converters.hs index 2dc94c060..7853fc79c 100644 --- a/src/Ampersand/ADL1/P2A_Converters.hs +++ b/src/Ampersand/ADL1/P2A_Converters.hs @@ -937,16 +937,16 @@ pCtx2aCtx pPat2aPat :: ContextInfo -> P_Pattern -> Guarded Pattern pPat2aPat ci ppat = - f <$> traverse (pRul2aRul ci (Just $ name ppat)) (pt_rls ppat) - <*> traverse (pIdentity2aIdentity ci (Just $ name ppat)) (pt_ids ppat) + f <$> traverse (pRul2aRul ci (Just $ label ppat)) (pt_rls ppat) + <*> traverse (pIdentity2aIdentity ci (Just $ label ppat)) (pt_ids ppat) <*> traverse (pPop2aPop ci) (pt_pop ppat) <*> traverse (pViewDef2aViewDef ci) (pt_vds ppat) <*> traverse (pPurp2aPurp ci) (pt_xps ppat) - <*> traverse (pDecl2aDecl (representationOf ci) cptMap (Just $ name ppat) deflangCtxt deffrmtCtxt) (pt_dcs ppat) + <*> traverse (pDecl2aDecl (representationOf ci) cptMap (Just $ label ppat) deflangCtxt deffrmtCtxt) (pt_dcs ppat) <*> traverse (pure . pConcDef2aConcDef (defaultLang ci) (defaultFormat ci)) (pt_cds ppat) <*> traverse (pure . pRoleRule2aRoleRule) (pt_RRuls ppat) <*> traverse pure (pt_Reprs ppat) - <*> traverse (pEnforce2aEnforce ci (Just $ name ppat)) (pt_enfs ppat) + <*> traverse (pEnforce2aEnforce ci (Just $ label ppat)) (pt_enfs ppat) where f rules' keys' pops' views' xpls relations conceptdefs roleRules representations enforces' = A_Pat @@ -968,13 +968,13 @@ pCtx2aCtx } pRul2aRul :: ContextInfo -> - Maybe Name -> -- name of pattern the rule is defined in (if any) + Maybe Text -> -- name of pattern the rule is defined in (if any), just for documentation purposes. P_Rule TermPrim -> Guarded Rule pRul2aRul ci mPat = typeCheckRul ci mPat . disambiguate (conceptMap ci) (termPrimDisAmb (conceptMap ci) (declDisambMap ci)) typeCheckRul :: ContextInfo -> - Maybe Name -> -- name of pattern the rule is defined in (if any) + Maybe Text -> -- name of pattern the rule is defined in (if any), just for documentation purposes. P_Rule (TermPrim, DisambPrim) -> Guarded Rule typeCheckRul @@ -1006,13 +1006,13 @@ pCtx2aCtx } pEnforce2aEnforce :: ContextInfo -> - Maybe Name -> -- name of pattern the rule is defined in (if any) + Maybe Text -> -- name of pattern the enforcement rule is defined in (if any), just for documentation purposes. P_Enforce TermPrim -> Guarded AEnforce pEnforce2aEnforce ci mPat = typeCheckEnforce ci mPat . disambiguate (conceptMap ci) (termPrimDisAmb (conceptMap ci) (declDisambMap ci)) typeCheckEnforce :: ContextInfo -> - Maybe Name -> -- name of pattern the enforce is defined in (if any) + Maybe Text -> -- name of pattern the enforcement rule is defined in (if any), just for documentation purposes. P_Enforce (TermPrim, DisambPrim) -> Guarded AEnforce typeCheckEnforce @@ -1091,7 +1091,7 @@ pCtx2aCtx lbl' = "Compute " <> tshow rel <> " using " <> command pIdentity2aIdentity :: ContextInfo -> - Maybe Name -> -- name of pattern the rule is defined in (if any) + Maybe Text -> -- name of pattern the rule is defined in (if any), just for documentation purposes. P_IdentDef -> Guarded IdentityRule pIdentity2aIdentity ci mPat pidt = @@ -1336,12 +1336,12 @@ pAtomValue2aAtomValue typ cpt pav = pDecl2aDecl :: (A_Concept -> TType) -> ConceptMap -> - Maybe Name -> -- name of pattern the rule is defined in (if any) + Maybe Text -> -- label of pattern the rule is defined in (if any), just for documentation purposes Lang -> -- The default language PandocFormat -> -- The default pandocFormat P_Relation -> Guarded Relation -pDecl2aDecl typ cptMap maybePatName defLanguage defFormat pd = +pDecl2aDecl typ cptMap maybePatLabel defLanguage defFormat pd = do checkEndoProps --propLists <- mapM pProp2aProps . Set.toList $ dec_prps pd @@ -1357,7 +1357,7 @@ pDecl2aDecl typ cptMap maybePatName defLanguage defFormat pd = decMean = map (pMean2aMean defLanguage defFormat) (dec_Mean pd), decfpos = origin pd, decusr = True, - decpat = maybePatName, + decpat = maybePatLabel, dechash = hash (dec_nm pd) `hashWithSalt` decSign } where diff --git a/src/Ampersand/Core/AbstractSyntaxTree.hs b/src/Ampersand/Core/AbstractSyntaxTree.hs index 8237a4ee5..07a20fbbc 100644 --- a/src/Ampersand/Core/AbstractSyntaxTree.hs +++ b/src/Ampersand/Core/AbstractSyntaxTree.hs @@ -162,7 +162,7 @@ data A_Context = ACtx -- | used for Pandoc authors (and possibly other things) ctxmetas :: ![MetaData], ctxInfo :: !ContextInfo, - -- | All user defined enforce statements in this context, but outside patterns. + -- | All user defined enforcement rules in this context, but outside patterns. ctxEnforces :: ![AEnforce] } deriving (Typeable) @@ -240,8 +240,8 @@ data AEnforce = AEnforce enfRel :: !Relation, enfOp :: !EnforceOperator, enfExpr :: !Expression, - -- | If the Enforce is defined in the context of a pattern, the name of that pattern. - enfPatName :: !(Maybe Name), + -- | If the enforcement rule is defined in the context of a pattern, the name of that pattern. + enfPatName :: !(Maybe Text), enfRules :: ![Rule] } deriving (Eq) @@ -332,8 +332,8 @@ data Rule = Rule rrmsg :: ![Markup], -- | Custom presentation for violations, currently only in a single language rrviol :: !(Maybe (PairView Expression)), - -- | If the rule is defined in the context of a pattern, the name of that pattern. - rrpat :: !(Maybe Name), + -- | If the rule is defined in the context of a pattern, the label of that pattern for documentation purposes. + rrpat :: !(Maybe Text), -- | Where does this rule come from? rrkind :: !RuleKind } @@ -468,8 +468,8 @@ data Relation = Relation decfpos :: !Origin, -- | if true, this relation is declared by an author in the Ampersand script; otherwise it was generated by Ampersand. decusr :: !Bool, - -- | If the relation is declared inside a pattern, the name of that pattern. - decpat :: !(Maybe Name), + -- | If the relation is declared inside a pattern, the label of that pattern, just for documentation purposes. + decpat :: !(Maybe Text), dechash :: !Int } deriving (Typeable, Data) @@ -523,8 +523,8 @@ data IdentityRule = Id 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. - idPat :: !(Maybe Name), + -- | if defined within a pattern, then the label of that pattern. + idPat :: !(Maybe Text), -- | the constituent attributes (i.e. name/term pairs) of this identity. identityAts :: NE.NonEmpty IdentitySegment } diff --git a/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs b/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs index e620abf43..ae65d9351 100644 --- a/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs +++ b/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs @@ -529,9 +529,9 @@ chpDiagnosis env fSpec ) -- Rows: [ [(plain . str . text1ToText . tName) rol] - <> [(plain . str . maybe "--" (text1ToText . tName) . rrpat) rul | multProcs] + <> [(plain . str . maybe "--" id . rrpat) rul | multProcs] <> [ (plain . str . label) rul, - (plain . str . maybe "--" (text1ToText . tName) . rrpat) rul + (plain . str . maybe "--" id . rrpat) rul ] | (rol, rul) <- fRoleRuls fSpec ] diff --git a/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs b/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs index 7ef1647e3..41d8feffd 100644 --- a/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs +++ b/src/Ampersand/Output/ToPandoc/SharedAmongChapters.hs @@ -723,10 +723,7 @@ legacyTable caption' cellspecs headers rows = toColSpec :: (Alignment, Double) -> ColSpec toColSpec (a, d) = (a, ColWidth d) tHead :: TableHead - tHead = TableHead nullAttr (zipWith toRow (map fst cellspecs) headers) - where - toRow :: Alignment -> Blocks -> Row - toRow a bs = Row nullAttr (map (toCell a . singleton) $ toList bs) + tHead = (TableHead nullAttr . toList . singleton . Row nullAttr . map (toCell AlignDefault)) headers toCell :: Alignment -> Blocks -> Cell toCell a b = Cell nullAttr a (RowSpan 1) (ColSpan 1) (toList b) tBodies :: [TableBody] From 57740bb30012912bc06ab4d138ae9f0af335dc76 Mon Sep 17 00:00:00 2001 From: Stef Joosten Date: Fri, 13 Oct 2023 08:17:39 +0200 Subject: [PATCH 05/16] use labels in the data analysis chapter --- .../Output/ToPandoc/ChapterDataAnalysis.hs | 38 +++++++++---------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/Ampersand/Output/ToPandoc/ChapterDataAnalysis.hs b/src/Ampersand/Output/ToPandoc/ChapterDataAnalysis.hs index 7295bdd42..756c5a224 100644 --- a/src/Ampersand/Output/ToPandoc/ChapterDataAnalysis.hs +++ b/src/Ampersand/Output/ToPandoc/ChapterDataAnalysis.hs @@ -146,7 +146,7 @@ chpDataAnalysis env fSpec = (theBlocks, []) (plain . text . l) (NL "Aantal", EN "Count"), (plain . text . l) (NL "Vullingsgraad", EN "Filling degree") ] - [ [ (plain . text . text1ToText . tName) c, + [ [ (plain . text . label) c, meaningOf c <> (mconcat . map (amPandoc . explMarkup) . purposesOf fSpec outputLang') c, (plain . text . tshow . Set.size . atomsInCptIncludingSmaller fSpec) c, @@ -179,7 +179,7 @@ chpDataAnalysis env fSpec = (theBlocks, []) (plain . text . l) (NL "Voorbeelden", EN "Examples"), (plain . text . l) (NL "Aantal", EN "Count") ] - [ [ (plain . text . text1ToText . tName) c + [ [ (plain . text . label) c ] -- max 20 voorbeelden van atomen van concept c ++ (map (plain . text . showA) . take 20 . Set.toList . atomsInCptIncludingSmaller fSpec) c ++ [ (plain . text . tshow . Set.size . atomsInCptIncludingSmaller fSpec) c @@ -222,7 +222,7 @@ chpDataAnalysis env fSpec = (theBlocks, []) (plain . text . l) (NL "#uniek", EN "#unique") ] ( [ [ (plain . text . text1ToText . sqlColumNameToText1 . attSQLColName) attr, - (plain . text) ((text1ToText . tName . target . attExpr) attr <> "(" <> tshow nTgtConcept <> ")"), -- use "tshow.attType" for the technical type. + (plain . text) ((label . target . attExpr) attr <> "(" <> tshow nTgtConcept <> ")"), -- use "tshow.attType" for the technical type. (plain . text) (percent (Set.size pairs) n), (plain . text . tshow . Set.size . Set.map apRight) pairs ] @@ -232,7 +232,7 @@ chpDataAnalysis env fSpec = (theBlocks, []) pairs <- [(pairsInExpr fSpec . attExpr) (attr :: SqlAttribute)] ] <> [ [ (plain . text . text1ToText . sqlColumNameToText1 . attSQLColName) attr, - (plain . text) ((text1ToText . tName . target . attExpr) attr <> "(" <> tshow nTgtConcept <> ")"), -- use "tshow.attType" for the technical type. + (plain . text) ((label . target . attExpr) attr <> "(" <> tshow nTgtConcept <> ")"), -- use "tshow.attType" for the technical type. (plain . text) (percent (Set.size pairs) n), (plain . text . tshow . Set.size . Set.map apRight) pairs -- , (plain . text . tshow) nTgtConcept @@ -259,10 +259,10 @@ chpDataAnalysis env fSpec = (theBlocks, []) (plain . text . l) (NL "Target", EN "Target"), (plain . text . l) (NL "uniek", EN "unique") ] - [ [ (plain . text) ((text1ToText . tName . source) rel <> "(" <> tshow nSrcConcept <> ")"), -- use "tshow.attType" for the technical type. + [ [ (plain . text) ((label . source) rel <> "(" <> tshow nSrcConcept <> ")"), -- use "tshow.attType" for the technical type. (plain . text) (percent (Set.size (Set.map apLeft pairs)) nSrcConcept), - (plain . text) ((text1ToText . tName) rel <> "(" <> tshow (Set.size pairs) <> ")"), - (plain . text) ((text1ToText . tName . target) rel <> "(" <> tshow nTgtConcept <> ")"), -- use "tshow.attType" for the technical type. + (plain . text) ((label) rel <> "(" <> tshow (Set.size pairs) <> ")"), + (plain . text) ((label . target) rel <> "(" <> tshow nTgtConcept <> ")"), -- use "tshow.attType" for the technical type. (plain . text) (percent (Set.size (Set.map apRight pairs)) nTgtConcept) ] | Just rel <- map assmdcl asscs, @@ -308,11 +308,11 @@ chpDataAnalysis env fSpec = (theBlocks, []) <> mconcat [ simpleTable [plainText "Concept", plainText "C", plainText "R", plainText "U", plainText "D"] - [ [ (plainText . text1ToText . tName) cncpt, - mconcat . map (plainText . text1ToText . tName) $ ifcsC, - mconcat . map (plainText . text1ToText . tName) $ ifcsR, - mconcat . map (plainText . text1ToText . tName) $ ifcsU, - mconcat . map (plainText . text1ToText . tName) $ ifcsD + [ [ (plainText . label) cncpt, + mconcat . map (plainText . label) $ ifcsC, + mconcat . map (plainText . label) $ ifcsR, + mconcat . map (plainText . label) $ ifcsU, + mconcat . map (plainText . label) $ ifcsD ] | (cncpt, (ifcsC, ifcsR, ifcsU, ifcsD)) <- crudObjsPerConcept (crudInfo fSpec) ] @@ -401,7 +401,7 @@ chpDataAnalysis env fSpec = (theBlocks, []) Dutch -> "Dit attribuut verwijst naar een rij in de tabel " English -> "This attribute is a foreign key to " ) - <> (text . text1ToText . tName) c + <> (text . label) c PlainAttr -> ( case outputLang' of Dutch -> "Dit attribuut implementeert " @@ -474,7 +474,7 @@ chpDataAnalysis env fSpec = (theBlocks, []) docRule :: LocalizedStr -> Rule -> Blocks docRule heading rule = mconcat - [ plain $ strong (text (l heading <> ": ") <> (emph . text . text1ToText . tName) rule), + [ plain $ strong (text (l heading <> ": ") <> (emph . text . label) rule), mconcat . map (amPandoc . explMarkup) . purposesOf fSpec outputLang' $ rule, printMeaning outputLang' rule, para (showMath rule), @@ -506,12 +506,12 @@ primExpr2pandocMath lang e = case lang of Dutch -> text "de relatie " English -> text "the relation " - <> math ((text1ToText . tName . source) d <> " \\rightarrow {" <> (text1ToText . tName) d <> "} " <> (text1ToText . tName . target) d) + <> math ((label . source) d <> " \\rightarrow {" <> label d <> "} " <> (label . target) d) (EFlp (EDcD d)) -> case lang of Dutch -> text "de relatie " English -> text "the relation " - <> math ((text1ToText . tName . source) d <> " \\leftarrow {" <> (text1ToText . tName) d <> "} " <> (text1ToText . tName . target) d) + <> math ((label . source) d <> " \\leftarrow {" <> label d <> "} " <> (label . target) d) (EIsc (r1, _)) -> let srcTable = case r1 of EDcI c -> c @@ -519,15 +519,15 @@ primExpr2pandocMath lang e = in case lang of Dutch -> text "de identiteitsrelatie van " English -> text "the identityrelation of " - <> math (text1ToText . tName $ srcTable) + <> math (label $ srcTable) (EDcI c) -> case lang of Dutch -> text "de identiteitsrelatie van " English -> text "the identityrelation of " - <> math (text1ToText . tName $ c) + <> math (label $ c) (EEps c _) -> case lang of Dutch -> text "de identiteitsrelatie van " English -> text "the identityrelation of " - <> math (text1ToText . tName $ c) + <> math (label $ c) _ -> fatal ("Have a look at the generated Haskell to see what is going on..\n" <> tshow e) From d7ae88ec50138bb9f4c381da5658e07ca7a6be16 Mon Sep 17 00:00:00 2001 From: Stef Joosten Date: Fri, 13 Oct 2023 08:41:22 +0200 Subject: [PATCH 06/16] use labels in the conceptual analysis --- .../ToPandoc/ChapterConceptualAnalysis.hs | 12 +++++------ .../Output/ToPandoc/ChapterIntroduction.hs | 21 ++++++++++--------- 2 files changed, 17 insertions(+), 16 deletions(-) diff --git a/src/Ampersand/Output/ToPandoc/ChapterConceptualAnalysis.hs b/src/Ampersand/Output/ToPandoc/ChapterConceptualAnalysis.hs index 3eed58680..3987b7abd 100644 --- a/src/Ampersand/Output/ToPandoc/ChapterConceptualAnalysis.hs +++ b/src/Ampersand/Output/ToPandoc/ChapterConceptualAnalysis.hs @@ -84,11 +84,11 @@ chpConceptualAnalysis env lev fSpec = <> ( case (outputLang', patOfTheme themeContent) of (Dutch, Just pat) -> -- announce the conceptual diagram - para (hyperLinkTo (pictOfPat pat) <> "Conceptueel diagram van " <> (singleQuoted . str . text1ToText . tName) pat <> ".") + para (hyperLinkTo (pictOfPat pat) <> "Conceptueel diagram van " <> (singleQuoted . str . label) pat <> ".") -- draw the conceptual diagram <> (xDefBlck env fSpec . pictOfPat) pat (English, Just pat) -> - para (hyperLinkTo (pictOfPat pat) <> "Conceptual diagram of " <> (singleQuoted . str . text1ToText . tName) pat <> ".") + para (hyperLinkTo (pictOfPat pat) <> "Conceptual diagram of " <> (singleQuoted . str . label) pat <> ".") <> (xDefBlck env fSpec . pictOfPat) pat (_, Nothing) -> mempty ) @@ -207,8 +207,8 @@ chpConceptualAnalysis env lev fSpec = case rrkind r of Identity c -> (para . l) - ( NL ("Een identiteit op \"" <> (text1ToText . tName) c <> "\" is gedefinieerd, zij het zonder PURPOSE."), - EN ("An identity rule for \"" <> (text1ToText . tName) c <> "\" is defined, albeit without a purpose.") + ( NL ("Een identiteit op \"" <> (label) c <> "\" is gedefinieerd, zij het zonder PURPOSE."), + EN ("An identity rule for \"" <> (label) c <> "\" is defined, albeit without a purpose.") ) _ -> fatal "The result of idRulesOfTheme themeContent has produced a RuleCont whose rrkind is not Identity c." caRemainingRelations :: Blocks @@ -219,7 +219,7 @@ chpConceptualAnalysis env lev fSpec = (plain . l) (NL "Betekenis", EN "Meaning") ] ( [ [ (plain . text) - ( (text1ToText . tName) rel <> " " + ( label rel <> " " <> if null cls then tshow (sign rel) else localize outputLang' (NL " (Attribuut van ", EN " (Attribute of ") <> (T.concat . map (text1ToText . tName)) cls <> ")" @@ -338,7 +338,7 @@ chpConceptualAnalysis env lev fSpec = ( L.intersperse (str ", ") [ hyperLinkTo (XRefConceptualAnalysisRelation d) - <> text (" (" <> (text1ToText . tName) d <> ")") + <> text (" (" <> label d <> ")") | d <- toList $ bindedRelationsIn r ] ) diff --git a/src/Ampersand/Output/ToPandoc/ChapterIntroduction.hs b/src/Ampersand/Output/ToPandoc/ChapterIntroduction.hs index 98082f692..e4487c1b7 100644 --- a/src/Ampersand/Output/ToPandoc/ChapterIntroduction.hs +++ b/src/Ampersand/Output/ToPandoc/ChapterIntroduction.hs @@ -19,6 +19,7 @@ chpIntroduction env now fSpec = else purposesOfContext where outputLang' = outputLang env fSpec + fSpecName = (singleQuoted . text . text1ToText . tName) fSpec readingGuide = case outputLang' of Dutch -> @@ -26,10 +27,10 @@ chpIntroduction env now fSpec = ( text "Dit document" <> (note . para . text) ("Dit document is gegenereerd op " <> date <> " om " <> time <> ", dmv. " <> longVersion appVersion <> ".") <> text " definieert de functionaliteit van een informatiesysteem genaamd " - <> (singleQuoted . text . text1ToText . tName) fSpec + <> fSpecName <> text ". " <> text "Het definieert de database en de business-services van " - <> (text . text1ToText . tName) fSpec + <> fSpecName <> text " door middel van bedrijfsregels" <> (note . para . text) "Het ontwerpen met bedrijfsregels is een kenmerk van de Ampersand aanpak, die gebruikt is bij het samenstellen van dit document. " <> text ". " @@ -66,12 +67,12 @@ chpIntroduction env now fSpec = then para ( text "De hoofdstukken die dan volgen zijn bedoeld voor de bouwers van " - <> (singleQuoted . text . text1ToText . tName) fSpec + <> fSpecName <> text ". " <> text "De gegevensanalyse in " <> hyperLinkTo DataAnalysis <> text " beschrijft de gegevensverzamelingen waarop " - <> (singleQuoted . text . text1ToText . tName) fSpec + <> fSpecName <> text " wordt gebouwd. " <> text "Elk volgend hoofdstuk definieert één business service. " <> text "Hierdoor kunnen bouwers zich concentreren op één service tegelijk. " @@ -79,7 +80,7 @@ chpIntroduction env now fSpec = <> para ( text "Tezamen ondersteunen deze services alle geldende afspraken. " <> text "Door alle functionaliteit uitsluitend via deze services te ontsluiten waarborgt " - <> (singleQuoted . text . text1ToText . tName) fSpec + <> fSpecName <> text " compliance ten aanzien van alle gestelde afspraken. " ) else mempty @@ -89,10 +90,10 @@ chpIntroduction env now fSpec = ( text "This document" <> (note . para . text) ("This document was generated at " <> date <> " on " <> time <> ", using " <> longVersion appVersion <> ".") <> text " defines the functionality of an information system called " - <> (singleQuoted . text . text1ToText . tName) fSpec + <> fSpecName <> text ". " <> text "It defines the database and the business services of " - <> (text . text1ToText . tName) fSpec + <> fSpecName <> text " by means of business rules" <> (note . para . text) "Rule based design characterizes the Ampersand approach, which has been used to produce this document. " <> text ". " @@ -128,12 +129,12 @@ chpIntroduction env now fSpec = then para ( text "Chapters that follow have the builders of " - <> (singleQuoted . text . text1ToText . tName) fSpec + <> fSpecName <> text " as their intended audience. " <> text "The data analysis in " <> hyperLinkTo DataAnalysis <> text " describes the data sets upon which " - <> (singleQuoted . text . text1ToText . tName) fSpec + <> fSpecName <> text " is built. " <> text "Each subsequent chapter defines one business service. " <> text "This allows builders to focus on a single service at a time. " @@ -141,7 +142,7 @@ chpIntroduction env now fSpec = <> para ( text "Together, these services fulfill all commitments. " <> text "By disclosing all functionality exclusively through these services, " - <> (singleQuoted . text . text1ToText . tName) fSpec + <> fSpecName <> text " ensures compliance to all rules agreed upon." ) else mempty From e379d3dc5a7a5ac80d553dcada8b4aff83a37ae4 Mon Sep 17 00:00:00 2001 From: Stef Joosten Date: Fri, 13 Oct 2023 10:55:51 +0200 Subject: [PATCH 07/16] FIX role-rule table in diagnosis chapter --- src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs b/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs index ae65d9351..6aa304ac8 100644 --- a/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs +++ b/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs @@ -119,7 +119,8 @@ chpDiagnosis env fSpec where ruls = Set.filter (isSignal fSpec) . vrules $ fSpec f :: Role -> Rule -> Blocks - f _ _ = mempty + f rol rul = if (rol,rul) `elem` fRoleRuls fSpec + then (plain . str) "✓" else mempty missingConceptDefs :: Blocks missingConceptDefs = From 2d146b3f3c1341a952fd81eaa95ce947def7eb29 Mon Sep 17 00:00:00 2001 From: Stef Joosten Date: Fri, 13 Oct 2023 12:18:38 +0200 Subject: [PATCH 08/16] minor --- src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs | 2 +- src/Ampersand/Graphic/Graphics.hs | 6 +++--- src/Ampersand/Prototype/ProtoUtil.hs | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs b/src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs index a606cc474..9f2c2845b 100644 --- a/src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs +++ b/src/Ampersand/FSpec/ToFSpec/ADL2FSpec.hs @@ -23,7 +23,7 @@ import qualified RIO.Set as Set import qualified RIO.Text as T {- The FSpec-datastructure should contain all "difficult" computations. This data structure is used by all sorts of rendering-engines, -such as the code generator, the functional-specification generator, and future extentions. -} +such as the code generator, the functional-specification generator, and future extensions. -} makeFSpec :: (HasFSpecGenOpts env) => env -> diff --git a/src/Ampersand/Graphic/Graphics.hs b/src/Ampersand/Graphic/Graphics.hs index dd2f6cb1b..5f04972ab 100644 --- a/src/Ampersand/Graphic/Graphics.hs +++ b/src/Ampersand/Graphic/Graphics.hs @@ -324,13 +324,13 @@ class ReferableFromPandoc a where instance ReferableFromPandoc Picture where imagePathRelativeToDirOutput env p = - "images" filename <.> extention + "images" filename <.> extension where filename = pictureFileName . pType $ p - extention = + extension = case view fspecFormatL env of Fpdf -> "png" -- When Pandoc makes a PDF file, Ampersand delivers the pictures in .png format. .pdf-pictures don't seem to work. - Fdocx -> "png" -- When Pandoc makes a .docx file, Ampersand delivers the pictures in .pdf format. The .svg format for scalable rendering does not work in MS-word. + Fdocx -> "png" -- When Pandoc makes a .docx file, Ampersand delivers the pictures in .pdf format. The .svg format for scalable rendering does not work in Pandoc. Fhtml -> "png" _ -> "dot" diff --git a/src/Ampersand/Prototype/ProtoUtil.hs b/src/Ampersand/Prototype/ProtoUtil.hs index 264280b7e..891defaf5 100644 --- a/src/Ampersand/Prototype/ProtoUtil.hs +++ b/src/Ampersand/Prototype/ProtoUtil.hs @@ -192,7 +192,7 @@ writeFile filePath content = do -- Copy entire directory tree from srcBase/ to tgtBase/, overwriting existing files, but not emptying existing directories. -- NOTE: tgtBase specifies the copied directory target, not its parent --- NOTE: directories with extention .proto are excluded. This would compromise regression tests, +-- NOTE: directories with extension .proto are excluded. This would compromise regression tests, -- where '.proto' is the default output directory (if not specified) copyDirRecursively :: (HasLogFunc env) => @@ -230,7 +230,7 @@ copyDirRecursively srcBase tgtBase else if takeExtension srcPath == defaultDirPrototype then do - logDebug $ "Skipping " <> display (T.pack srcPath) <> " because its extention is excluded by design" --This is because of regression tests. (See what happend at https://travis-ci.org/AmpersandTarski/Ampersand/jobs/621565925 ) + logDebug $ "Skipping " <> display (T.pack srcPath) <> " because its extension is excluded by design" --This is because of regression tests. (See what happend at https://travis-ci.org/AmpersandTarski/Ampersand/jobs/621565925 ) else do logDebug $ " Copying dir... " <> display (T.pack srcPath) logDebug $ " to dir... " <> display (T.pack tgtPath) From 6a8416974a0c2c9a86f5c0218ea91515544414fe Mon Sep 17 00:00:00 2001 From: Stef Joosten Date: Sun, 15 Oct 2023 08:03:23 +0200 Subject: [PATCH 09/16] minor bug (double occurence) fixed --- src/Ampersand/Basics/String.hs | 2 +- src/Ampersand/Basics/Unique.hs | 2 +- src/Ampersand/Input/ADL1/Parser.hs | 2 +- src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs | 12 +++++++----- src/Ampersand/Test/Parser/ArbitraryTree.hs | 2 +- 5 files changed, 11 insertions(+), 9 deletions(-) diff --git a/src/Ampersand/Basics/String.hs b/src/Ampersand/Basics/String.hs index 763253bc1..142f5ca52 100644 --- a/src/Ampersand/Basics/String.hs +++ b/src/Ampersand/Basics/String.hs @@ -126,4 +126,4 @@ toBaseFileName txt = concatMap convertChar $ T.unpack txt convertChar c | isSpace c = ['_'] | c `elem` ['<', '>', ':', '\"', '/', '\\', '|', '?', '*'] = '%' : show (ord c) - | otherwise = [c] \ No newline at end of file + | otherwise = [c] diff --git a/src/Ampersand/Basics/Unique.hs b/src/Ampersand/Basics/Unique.hs index 00b0722f7..564e431ca 100644 --- a/src/Ampersand/Basics/Unique.hs +++ b/src/Ampersand/Basics/Unique.hs @@ -106,4 +106,4 @@ instance Unique a => Unique (Set.Set a) where showUnique = showUnique . toList instance Unique Bool where - showUnique = toText1Unsafe . T.toLower . tshow \ No newline at end of file + showUnique = toText1Unsafe . T.toLower . tshow diff --git a/src/Ampersand/Input/ADL1/Parser.hs b/src/Ampersand/Input/ADL1/Parser.hs index 3607ad3df..57930ca52 100644 --- a/src/Ampersand/Input/ADL1/Parser.hs +++ b/src/Ampersand/Input/ADL1/Parser.hs @@ -1126,4 +1126,4 @@ pContent = pBrackets (pRecord `sepBy` (pComma <|> pSemi)) pLabel :: AmpParser Label pLabel = Label <$ (pKey . toText1Unsafe $ "LABEL") - <*> pDoubleQuotedString \ No newline at end of file + <*> pDoubleQuotedString diff --git a/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs b/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs index 6aa304ac8..02d6161c9 100644 --- a/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs +++ b/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs @@ -119,8 +119,10 @@ chpDiagnosis env fSpec where ruls = Set.filter (isSignal fSpec) . vrules $ fSpec f :: Role -> Rule -> Blocks - f rol rul = if (rol,rul) `elem` fRoleRuls fSpec - then (plain . str) "✓" else mempty + f rol rul = + if (rol, rul) `elem` fRoleRuls fSpec + then (plain . str) "✓" + else mempty missingConceptDefs :: Blocks missingConceptDefs = @@ -159,9 +161,9 @@ chpDiagnosis env fSpec ) where missing = - [ c | c <- ccs, null (purposesOf fSpec outputLang' c) - ] - <> [c | c <- ccs, null (concDefs fSpec c)] + L.nub $ + [c | c <- ccs, null (purposesOf fSpec outputLang' c)] + <> [c | c <- ccs, null (concDefs fSpec c)] ccs = toList . concs . vrels $ fSpec unusedConceptDefs :: Blocks diff --git a/src/Ampersand/Test/Parser/ArbitraryTree.hs b/src/Ampersand/Test/Parser/ArbitraryTree.hs index 508ba7bc7..03558a34f 100644 --- a/src/Ampersand/Test/Parser/ArbitraryTree.hs +++ b/src/Ampersand/Test/Parser/ArbitraryTree.hs @@ -581,4 +581,4 @@ safePlainName = oneof [ identifier, safeStr1 `suchThat` (not . null . T.words . text1ToText) - ] \ No newline at end of file + ] From 84007b6607870887d0662c6e096764d902748c5e Mon Sep 17 00:00:00 2001 From: Stef Joosten Date: Sun, 15 Oct 2023 14:17:01 +0200 Subject: [PATCH 10/16] tidy the generated func. spec. a bit --- .../Output/ToPandoc/ChapterDiagnosis.hs | 20 ++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs b/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs index 02d6161c9..c2054b1cf 100644 --- a/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs +++ b/src/Ampersand/Output/ToPandoc/ChapterDiagnosis.hs @@ -7,6 +7,7 @@ import Ampersand.Output.ToPandoc.SharedAmongChapters import qualified RIO.List as L import qualified RIO.Set as Set import qualified RIO.Text as T +import System.FilePath chpDiagnosis :: (HasDirOutput env, HasDocumentOpts env) => @@ -447,12 +448,22 @@ chpDiagnosis env fSpec where formalizations rls = bulletList - [ para ((emph . str . label) r <> " (" <> (str . tshow . origin) r <> ")") + [ para ((emph . str . label) r <> " (" <> (str . tShowOrigin) r <> ")") <> (para . showMath . formalExpression) r <> (para . showPredLogic outputLang' . formalExpression) r | r <- rls ] + tShowOrigin :: (Traced x) => x -> Text + tShowOrigin = tshow . stripDirectory . origin + where + stripDirectory :: Origin -> Origin + stripDirectory (FileLoc pos' x) = FileLoc (f pos') x + stripDirectory fileLoc = fileLoc + -- data FilePos = FilePos FilePath Line Column deriving (Eq, Ord, Generic, Typeable, Data) + f :: FilePos -> FilePos + f (FilePos pth line col) = FilePos (takeFileName pth) line col + ruleRelationRefTable :: Blocks ruleRelationRefTable = (para . str . l) @@ -581,7 +592,7 @@ chpDiagnosis env fSpec [ map (plain . str) [ (label) r, - (tshow . origin) r, + tShowOrigin r, (tshow . length) ps ] | (r, ps) <- popwork @@ -591,10 +602,9 @@ chpDiagnosis env fSpec mconcat [ para ( str (l (NL "Afspraak ", EN "Agreement ")) - <> hyperLinkTo (XRefSharedLangRule r) - <> " ( " + -- Pandoc does not yield hyperlinks in Word files, so we cannot do: + -- <> hyperLinkTo (XRefSharedLangRule r) <> " ( " <> quoterule r <> " )" <> quoterule r - <> " )" <> (str . l) (NL " luidt: ", EN " says: ") ) <> printMeaning outputLang' r From 0d7b703a97a1f0df8b96df246a7a21f2276369d6 Mon Sep 17 00:00:00 2001 From: hanjoosten Date: Thu, 7 Dec 2023 11:55:56 +0100 Subject: [PATCH 11/16] Add note about broken links when not a member --- docs/guides/onboarding.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/docs/guides/onboarding.md b/docs/guides/onboarding.md index 2196a728d..48363697e 100644 --- a/docs/guides/onboarding.md +++ b/docs/guides/onboarding.md @@ -20,6 +20,8 @@ Request membership to - [AmpersandTarski](https://github.com/orgs/AmpersandTarski/people) organization and - [Ordina A-team](https://github.com/orgs/AmpersandTarski/teams/ordina-a-team/members). +Above links only work for members of AmpersandTarski + :::tip Make sure when you contact Han about this that you provide him with your Github account name (or URL to your GitHub profile page). ::: From 86e4abb252fdc6e9ad1455f73cbf15ce7161df5b Mon Sep 17 00:00:00 2001 From: Stef Joosten Date: Mon, 11 Dec 2023 13:13:41 +0100 Subject: [PATCH 12/16] include another example (Multiple files in a specification) --- docs/Examples.md | 21 +++++++++++++++++++ docs/landingpage/2-student.md | 1 + docs/landingpage/3-ampersand-user.md | 1 + docs/reference-material/interfaces.md | 4 ++-- .../reference-material/syntax-of-ampersand.md | 8 +++---- docs/tutorial/interfaces.md | 2 +- 6 files changed, 30 insertions(+), 7 deletions(-) diff --git a/docs/Examples.md b/docs/Examples.md index 5816a4c5c..903410e9c 100644 --- a/docs/Examples.md +++ b/docs/Examples.md @@ -9,6 +9,27 @@ description: Examples of Ampersand programs and fragments This page is a collection of examples, meant for learning and explaining the language Ampersand. TODO: refactor this documentation to match the latest syntax. +## Example: Multiple files +This example illustrates how an Ampersand specification can consist of multiple files. + +In this example, we have two files. File `foo.adl` contains the following text: +```Ampersand +CONTEXT MultifileDemo +INCLUDE "bar.adl" +RELATION r[A*B] +RULE r |- s +ENDCONTEXT +``` +and file `bar.adl` contains: +```Ampersand +CONTEXT MultifileDemo +INCLUDE "bar.adl" +RELATION s[A*B] +ENDCONTEXT +``` +Without the `INCLUDE` statement, file `foo.adl` does not compile because relation `s` is undefined. +The `INCLUDE` statement causes all definitions of `bar.adl` to be included in the context of `foo.adl`, so this example compiles without errors. + ## Example: Client {#interfaces-example-client} This example illustrates the structure of [interfaces in Ampersand](reference-material/syntax-of-ampersand#the-interface-statement) diff --git a/docs/landingpage/2-student.md b/docs/landingpage/2-student.md index e3b95fc6b..118057c66 100644 --- a/docs/landingpage/2-student.md +++ b/docs/landingpage/2-student.md @@ -12,4 +12,5 @@ You can learn about the language Ampersand, and learn how to make a prototype of - Do the [tutorial](../tutorial-rap4), to get an idea of an Ampersand application - Learn about the [syntax of Ampersand](../reference-material/syntax-of-ampersand), to write correct Ampersand code. - Learn about [relation algebra](https://en.wikipedia.org/wiki/Relational_algebra) on Wikipedia, to understand more about this fascinating field of mathematics. +- Find [examples](../examples.md) of Ampersand specifications, to get started making your own. - Find [exercises](../exercises.md) that help you improve your skills in specifying information systems. diff --git a/docs/landingpage/3-ampersand-user.md b/docs/landingpage/3-ampersand-user.md index f7aa2ff6d..497d92e9b 100644 --- a/docs/landingpage/3-ampersand-user.md +++ b/docs/landingpage/3-ampersand-user.md @@ -11,6 +11,7 @@ This page will help you build a working prototype of your information system and ## Get started - Do the [tutorial](../tutorial-rap4), to get an idea of an Ampersand application +- Find [examples](../examples.md) of Ampersand specifications, to get started making your own. - Understand the [architecture of an Ampersand application](../reference-material/architecture-of-an-ampersand-application), so you can build, deploy, and maintain your Ampersand application better. - Learn about the [syntax of Ampersand](../reference-material/syntax-of-ampersand), to write correct Ampersand code. - Learn about [relation algebra](https://en.wikipedia.org/wiki/Relational_algebra) on Wikipedia, to understand more about this fascinating field of mathematics. diff --git a/docs/reference-material/interfaces.md b/docs/reference-material/interfaces.md index c7c40ca4b..ed6b98317 100644 --- a/docs/reference-material/interfaces.md +++ b/docs/reference-material/interfaces.md @@ -276,5 +276,5 @@ When running an application in your browser, you are watching one user interface The next sections contain two examples: -- a [client interface](../Examples.md#interfaces-example-client) to allow clients of a web shop to change their name and address and show them status information of their orders; -- a [login interface](../Examples.md#interfaces-example-login) to demonstrate how to get different interface structures under varying conditions. +- a [client interface](../examples.md#interfaces-example-client) to allow clients of a web shop to change their name and address and show them status information of their orders; +- a [login interface](../examples.md#interfaces-example-login) to demonstrate how to get different interface structures under varying conditions. diff --git a/docs/reference-material/syntax-of-ampersand.md b/docs/reference-material/syntax-of-ampersand.md index 549191fee..12e8da255 100644 --- a/docs/reference-material/syntax-of-ampersand.md +++ b/docs/reference-material/syntax-of-ampersand.md @@ -795,7 +795,7 @@ Interfaces are meant to expose functionality and data from a [context](#the-cont #### Description -An interface is a component of an information system that exposes functionality and data from a [context](#the-context-statement), to let users or information systems interact by creating, reading, updating, and deleting data. The first [example](../Examples.md#example-interface-structure) introduces a simple interface informally. Another [example](../Examples.md#interface-introductory-example) introduces the main features of an interface with nested interfaces. +An interface is a component of an information system that exposes functionality and data from a [context](#the-context-statement), to let users or information systems interact by creating, reading, updating, and deleting data. The first [example](../examples.md#example-interface-structure) introduces a simple interface informally. Another [example](../examples.md#interface-introductory-example) introduces the main features of an interface with nested interfaces. A _interface_ is a component of an information system. During the time that this interface can actually be used, we say it is _deployed_. We also call this the _lifetime_ of a interface. A typical instance of a interface is a user interface based on HTML-CSS that runs in a browser. But an application program interface \(API\) that serves other computers with web services is a perfectly valid instance as well. @@ -859,8 +859,8 @@ When running an application in your browser, you are watching one user interface Further examples: -- a [client interface](../Examples.md#interfaces-example-client) to allow clients of a web shop to change their name and address and show them status information of their orders; -- a [login interface](../Examples.md#interfaces-example-login) to demonstrate how to get different interface structures under varying conditions. +- a [client interface](../examples.md#interfaces-example-client) to allow clients of a web shop to change their name and address and show them status information of their orders; +- a [login interface](../examples.md#interfaces-example-login) to demonstrate how to get different interface structures under varying conditions. ### CRUD annotations @@ -1498,7 +1498,7 @@ RULE