{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE ScopedTypeVariables #-} module DatabaseDesign.Ampersand.Output.ToPandoc.ChapterInterfaces ( chpInterfacesPics , chpInterfacesBlocks ) where import DatabaseDesign.Ampersand.Output.ToPandoc.SharedAmongChapters import DatabaseDesign.Ampersand.ADL1 import Data.List import DatabaseDesign.Ampersand.Fspec.Fspec import DatabaseDesign.Ampersand.Fspec.Switchboard (switchboardAct) import DatabaseDesign.Ampersand.Output.PandocAux chpInterfacesPics :: Fspc -> Options -> [Picture] chpInterfacesPics fSpec flags = concat [picKnowledgeGraph flags fSpec act : [picSwitchboard flags fSpec act | graphic flags] | act <- fActivities fSpec ] chpInterfacesBlocks :: Int -> Fspc -> Options -> Blocks chpInterfacesBlocks lev fSpec flags = foldr (<>) mempty (map interfaceChap (fActivities fSpec)) where interfaceChap :: Activity -> Blocks interfaceChap act -- TODO: This should be one chapter for all interfaces. = ( fromList $ header act ++ ifcIntro act ++ (if genGraphics flags then txtKnowledgeGraph act else []) -- ifcFieldTables ++ (if graphic flags then txtSwitchboard act else []) -- , picKnowledgeGraph : [picSwitchboard | graphic] ) header :: Activity ->[Block] header act = toList (labeledThing flags lev ("chpIfc"++name act) (name act)) ifcIntro :: Activity -> [Block] ifcIntro act = purposes2Blocks flags purps ++ifcAutoRules act++ (if genEcaDoc flags then ifcEcaRules act else []) where purps = purposesDefinedIn fSpec (language flags) fSpec {- ifcInsDelConcepts :: [Block] ifcInsDelConcepts = let ics = fsv_creating act>-fsv_deleting act dcs = fsv_deleting act>-fsv_creating act ucs = fsv_deleting act `isc` fsv_creating act in case language flags of Dutch -> [Plain [Space]]++ if null ics && null dcs && null ucs then [Plain $ [Str "Deze interface maakt of verwijdert geen objecten langs geautomatiseerde weg."]] else if null ics && null dcs then [Plain $ [Str "Om regels te handhaven, mogen instanties van "]++commaNLPandoc (Str "en") (map (Str . name) ucs)++[Str " door deze interface geautomatiseerd worden aangemaakt en verwijderd."]] else if null ics && null ucs then [Plain $ [Str "Om regels te handhaven, mag deze interface instanties van "]++commaNLPandoc (Str "en") (map (Str . name) ucs)++[Str " geautomatiseerd verwijderen."]] else if null dcs && null ucs then [Plain $ [Str "Om regels te handhaven, mogen instanties van "]++commaNLPandoc (Str "en") (map (Str . name) ucs)++[Str " geautomatiseerd worden aangemaakt door deze interface."]] else if null ucs then [Plain $ [Str "Instanties van "]++commaNLPandoc (Str "en") (map (Str . name) ucs)++[Str " mogen worden toegevoegd en instanties van "]++f dcs++[Str " mogen worden verwijderd door deze interface. Dat gebeurt geautomatiseerd en uitsluitend waar nodig om regels te handhaven."]] else if null dcs then [Plain $ [Str "Deze interface mag instanties van "]++commaNLPandoc (Str "en") (map (Str . name) ics)++[Str " creeren, terwijl instanties van "]++commaNLPandoc (Str "en") (map (Str . name) ucs)++[Str " ook verwijderd mogen worden. Alleen waar nodig mag dit plaatsvinden om regels te handhaven."]] else if null ics then [Plain $ [Str "Deze interface mag instanties van "]++commaNLPandoc (Str "en") (map (Str . name) ucs)++[Str " wijzigen, maar instanties van "]++commaNLPandoc (Str "en") (map (Str . name) dcs)++[Str " mogen alleen worden verwijderd. Dat mag slechts dan gebeuren wanneer dat nodig is voor het handhaven van regels."]] else [Plain $ [Str "Deze interface maakt nieuwe instanties van concept"]++f ics++[Str ". Hij mag instanties van concept"]++f dcs++[Str " verwijderen, terwijl instanties van "]++commaNLPandoc (Str "en") (map (Str . name) ucs)++[Str " zowel gemaakt als vernietigd mogen worden."]] where f [x] = [Space, Str (name x), Space] f xs = [Str "en "]++commaNLPandoc (Str "en") (map (Str . name) xs) English -> [Plain [Space]]++ if null ics && null dcs && null ucs then [Plain $ [Str "In this interface, no objects are made or removed automatically."]] else if null ics && null dcs then [Plain $ [Str "In order to maintain rules, instances of "]++f ucs++[Str " may be created or deleted by this interface automatically."]] else if null ics && null ucs then [Plain $ [Str "In order to maintain rules, instances of "]++f dcs++[Str " may be deleted automatically by this interface."]] else if null dcs && null ucs then [Plain $ [Str "In order to maintain rules, instances of "]++f ics++[Str " may be automatically inserted by this interface."]] else if null ucs then [Plain $ [Str "Concept"]++f ics++[Str " may be inserted, and concept"]++f dcs++[Str " may be deleted by this interface. This happens only if necessary for maintaining rules."]] else if null dcs then [Plain $ [Str "By this interface, concept"]++f ucs++[Str " may be changed, but"]++f ics++[Str " may be created but not deleted. This happens only if necessary for maintaining rules."]] else if null ics then [Plain $ [Str "By this interface, concept"]++f ucs++[Str " may be changed, but"]++f dcs++[Str " may only be deleted. This happens only if necessary for maintaining rules."]] else [Plain $ [Str "This interface can create new instances of concept"]++f ics++[Str ". It may delete instances of concept"]++f dcs++[Str ", and instances of concept"]++f ucs++[Str " may be either created and removed. Such actions will take place only in order to maintain rules."]] where f [x] = [Space, Str (name x)] f xs = [Str "s "]++commaEngPandoc (Str "and") (map (Str . name) xs) -} ifcAutoRules :: Activity -> [Block] ifcAutoRules act = case language flags of Dutch -> [Plain ([Str "Activiteit",Space, Quoted SingleQuote [(Str . name . actRule) act], Space,Str "moet door een gebruiker met rol "]++commaNLPandoc (Str "of") rols++[Str" worden uitgevoerd."] ++ case length auts of 0 -> [] 1 -> [Space,Str "Daarbij wordt regel",Space]++auts++[Space,Str "gehandhaafd zonder interventie van de gebruiker."] _ -> [Space,Str "Daarbij worden regels",Space]++commaNLPandoc (Str "en") auts++[Space,Str "gehandhaafd zonder interventie van de gebruiker."] )] English -> [Plain ([Str "Activity",Space, Quoted SingleQuote [(Str . name . actRule) act], Space,Str "must be performed by a user with role "]++commaEngPandoc (Str "or") rols++[Str"."] ++ case length auts of 0 -> [] 1 -> [Space,Str "During that activity, rule",Space]++auts++[Space,Str "will be maintained without intervention of a user."] _ -> [Space,Str "During that activity, rules",Space]++commaEngPandoc (Str "and") auts++[Space,Str "will be maintained without intervention of a user."] )] where auts = nub [ Quoted SingleQuote [Str (name r)] | q<-actQuads act, let r=(cl_rule.qClauses) q, r_usr r == UserDefined] rols = nub [Str r | (r,rul)<-fRoleRuls fSpec, rul==actRule act] ifcEcaRules :: Activity -> [Block] ifcEcaRules act = ( case (language flags, actEcas act) of (Dutch,[]) -> [Plain [Str "Alle veranderingen die een gebruiker uitvoert zijn handmatig. Er is geen geautomatiseerde functionaliteit in deze activiteit."]] (English,[]) -> [Plain [Str "All changes a user makes are done by hand. There is no automated functionality in this activity."]] (Dutch,_) -> [Plain [Str "De volgende tabel laat zien welke edit-acties welke functie aanroepen."]] (English,_) -> [Plain [Str "The following table shows which edit actions invoke which function."]] )++ if length (actEcas act)<1 then [] else [ Table [] [AlignLeft,AlignLeft,AlignLeft] [0.0,0.0,0.0] ( case language flags of Dutch -> [[Plain [Str "actie"]] ,[Plain [Str "relatie"]] ,[Plain [Str "regel"]]] English -> [[Plain [Str "action"]] ,[Plain [Str "relation"]] ,[Plain [Str "rule"]]] ) [ [ [Plain [ (Str . show . eSrt.ecaTriggr) eca]] , [Plain [ (Str . show . eDcl.ecaTriggr) eca]] , [Plain (shwEca eca)] ] | eca<-actEcas act -- tail haalt het eerste veld, zijnde I[c], eruit omdat die niet in deze tabel thuishoort. ]] where shwEca :: ECArule -> [Inline] shwEca eca | isBlk (ecaAction eca) = Str "error: rule ": commaEngPandoc (Str "and") [ Quoted SingleQuote [Str (let nrRules = length rs s | nrRules == 0 = "" | nrRules == 1 = name (head rs) | otherwise = name (head rs)++" (and "++show(nrRules - 1)++" other rules)." in s )] | (_,rs)<-paMotiv (ecaAction eca) ] | isNop (ecaAction eca) = [ Str "no op"] | otherwise = [ Str "ECA rule ", Str ((show . ecaNum ) eca) ] {- ifcFieldTables = if null (fsv_fields act) then [] else if length (fsv_fields act)==1 then [ Para $ [ case language flags of Dutch -> Str "In deze interface is het volgende veld zichtbaar: " English -> Str "This interface has one field: " ] , head [b | BulletList [bs]<-[flds], b<-bs] ] else [ Para $ [ case language flags of Dutch -> Str "In deze interface zijn de volgende velden zichtbaar. " English -> Str "This interface has the following fields. " ] , flds ] where flds :: Block flds = BulletList [recur ((objctx.ifcObj.fsv_ifcdef) act) f | f<-fsv_fields act] where recur :: Expression -> Field -> [Block] recur e f | null (fld_sub f) = fld e f | otherwise = fld e f ++ [ BulletList [recur (ECps [e,fld_expr f']) f' | f'<-fld_sub f] ] fld e f = [ Para [ Str (dealWithUnderscores (fld_name f)++if null cols then "" else "("++intercalate ", " cols++")") ] , Para [ Str "display on start: ", Math InlineMath $ showMath (conjNF e) ] ] where cols = ["lijst" | fld_list f]++ ["verplicht" | fld_must f]++ ["nieuw" | fld_insAble f]++ ["verwijderbaar" | fld_delAble f] dealWithUnderscores :: String -> String dealWithUnderscores x = case x of [] -> [] '_':cs -> "\\_" ++ dealWithUnderscores cs c:cs -> c : dealWithUnderscores cs -} txtKnowledgeGraph :: Activity -> [Block] txtKnowledgeGraph act = (case language flags of -- announce the knowledge graph Dutch -> [Para [ Str "Figuur ", xrefReference (picKnowledgeGraph flags fSpec act) , Str " geeft de kennisgraaf weer voor deze interface."]] English -> [Para [ Str "Figure ", xrefReference (picKnowledgeGraph flags fSpec act) , Str " shows the knowledge graph of this interface."]] ) ++ [Plain (xrefFigure1 (picKnowledgeGraph flags fSpec act))] -- draw the knowledge graph txtSwitchboard :: Activity ->[Block] txtSwitchboard act = (if name act==name (head (fActivities fSpec)) then switchboardIntro else [])++ (case language flags of -- announce the switchboard diagram Dutch -> [Para [ Str "Figuur ", xrefReference (picSwitchboard flags fSpec act) , Str " geeft het schakelpaneel (switchboard diagram) weer voor deze interface."]] English -> [Para [ Str "Figure ", xrefReference (picSwitchboard flags fSpec act) , Str " shows the switchboard diagram of this interface."]] ) ++ [Plain (xrefFigure1 (picSwitchboard flags fSpec act))] -- draw the switchboard switchboardIntro :: [Block] switchboardIntro = if not (graphic flags) then [] else [ Para $ case language flags of -- tells us for who this interface exists Dutch -> [ Str "Iedere sectie in dit hoofdstuk beschrijft één activiteit. " , Str "Tijdens het uitvoeren van een activiteit zal een gebruiker populatie invoegen of verwijderen in verschillende relaties. " , Str "Hierdoor kunnen invarianten potentieel worden overtreden. " , Str "(Een invariant is een bedrijfsregel die op ieder moment waar moet blijven.) " , Str "De software die nodig is om invarianten waar te maken wordt automatisch gegenereerd. " , Str "De structuur van deze software wordt geïllustreerd door een zogenaamd schakelpaneel (switchboard-diagram), " , Str "waarvan u de eerste in figuur X aantreft. " , Str "Elk switchboard diagram bestaat uit drie kolommen: " , Str "Invariante regels staan in het midden en relaties staan aan de (linker en rechter) zijkanten. " , Str "Een pijl ter linkerzijde wijst van een relatie die ge-edit wordt naar een regel die daardoor mogelijk overtreden wordt. " , Str "Elke pijl ter rechterzijde van een regel representeert een edit-actie die nodig is om het waar-zijn ervan te herstellen. " , Str "Deze pijl wijst naar de relatie waarin deze herstel-actie moet worden uitgevoerd. " , Str "Een pijl gelabeled met '+' duidt op een insert event; een pijl met '-' op " , Str "Hierdoor onstaat een accuraat beeld op welke manier de activiteit alle invarianten handhaaft. " ] English -> [ Str "Every section in this chapter describes one activity. " , Str "While performing an activity, users will insert or delete population in various relations. " , Str "This may potentially violate invariants. " , Str "(An invariant is a business rule rules that must remain true at all times.) " , Str "The software to maintain the truth of invariant rules is generated automatically. " , Str "The structure of that software is illustrated by a so called switchboard diagram, " , Str "the first of which you will find in figure X. " , Str "Each switchboard diagram consists of three columns: " , Str "Invariant rules are drawn in the middle, and relations occur on the (right and left hand) sides. " , Str "An arrow on the left hand side points from a relation that may be edited to a rule that may be violated as a consequence thereof. " , Str "Each arrow on the right hand side of a rule represents an edit action that is required to restore its truth. " , Str "It points to the relation that is edited for that purpose. " , Str "If that arrow is labeled '+', it involves an insert event; if labeled '-' it refers to a delete event. " , Str "This yields an accurate perspective on the way in which invariants are maintained. " ] ] picKnowledgeGraph :: Options -> Fspc -> Activity ->Picture picKnowledgeGraph flags fSpec act = (makePicture flags fSpec Plain_CG act) -- the Picture that represents this interface's knowledge graph {caption = case language flags of Dutch ->"Taaldiagram van "++name act English ->"Language diagram of "++name act} -- where -- knGph = conceptualGraph fSpec flags Plain_CG act -- the DotGraph String that represents this interface's knowledge graph -- kn = printDotGraph knGph -- the String that represents this interface's knowledge graph picSwitchboard :: Options -> Fspc -> Activity -> Picture picSwitchboard flags fSpec act = (makePicture flags fSpec Plain_CG (switchboardAct fSpec act)) -- the Picture that represents this interface's knowledge graph {caption = case language flags of Dutch ->"Schakelpaneel van "++name act English ->"Switchboard of "++name act} -- where -- sbGph = switchboardAct fSpec act -- the DotGraph String that represents this interface's knowledge graph -- sb = printDotGraph sbGph -- the String that represents this interface's knowledge graph graphic :: Options -> Bool graphic flags = genGraphics flags && theme flags /= StudentTheme