ampersand-3.0.0: src/lib/DatabaseDesign/Ampersand/Fspec/Motivations.hs
{-# OPTIONS_GHC -Wall #-}
--TODO -> Maybe this module is useful at more places than just func spec rendering.
-- In that case it's not a Rendering module and it needs to be replaced
module DatabaseDesign.Ampersand.Fspec.Motivations (Motivated(purposeOf,purposesDefinedIn,explanations,explForObj), Meaning(..))
where
import DatabaseDesign.Ampersand.Core.AbstractSyntaxTree
import DatabaseDesign.Ampersand.Fspec.Fspec(Fspc(..),FProcess(..), Activity(..)) -- TODO FProc should not be in here at the first place... It has been put here because of the removal of Activities from Process
import DatabaseDesign.Ampersand.Basics
import Text.Pandoc
fatal :: Int -> String -> a
fatal = fatalMsg "Fspec.Motivations"
-- The general idea is that an Ampersand declaration such as:
-- PURPOSE RELATION r[A*B] IN ENGLISH
-- {+This text explains why r[A*B] exists-}
-- produces the exact right text in the functional specification
-- The class Motivated exists so that we can write the Haskell expression 'purposeOf fSpec l x'
-- anywhere we like for every type of x that could possibly be motivated in an Purpose.
-- 'purpose fSpec l x' produces all explanations related to x from the context (fSpec)
-- that are available in the language specified in 'l'.
-- The other functions in this class are solely meant to be used in the definition of purpose.
-- They are defined once for each instance of Explainable, not be used in other code.
-- TODO: Han, kan dat worden afgeschermd, zodat de programmeur alleen 'purpose' ziet en de andere functies
-- dus niet kan gebruiken?
-- @Stef: Ja, het is al zoveel mogelijk afgeschermd (zie definities die deze module exporteert, hierboven)
-- maar er wordt nog gebruik van gemaakt voor oa foutmeldingen in de atlas, en het prototype.
-- Zodra iemand iets anders verzint voor het gebruik van "ExplainOutputFormat(..),format",
-- kunnen deze uit de export-list van deze module worden verwijderd.
class Identified a => Motivated a where
purposeOf :: Fspc -> Lang -> a -> Maybe [Purpose] -- ^ explains the purpose of a, i.e. the reason why a exists. The purpose could be either given by the user, or generated by Ampersand.
-- Multiple purposes are allowed for the following reasons:
-- * Different purposes from different sources make me want to document them all.
-- * Combining two overlapping scripts from (i.e. from different authors) may cause multiple purposes.
purposeOf fSpec l x = case expls of
[] -> Nothing -- fatal 40 "No purpose is generated! (should be automatically generated and available in Fspc.)"
ps -> Just ps
where expls = [e | e<-explanations fSpec
, explForObj x (explObj e) -- informally: "if x and e are the same"
, markupMatchesLang (explMarkup e)
]
markupMatchesLang m = amLang m == l
explForObj :: a -> ExplObj -> Bool -- ^ Given an Explainable object and an ExplObj, return TRUE if they concern the identical object.
explanations :: a -> [Purpose] -- ^ The explanations that are defined inside a (including that of a itself)
purposesDefinedIn :: Fspc -> Lang -> a -> [Purpose] -- ^ The explanations that are defined inside a (including that of a itself)
purposesDefinedIn fSpec l x
= [e | e<-explanations fSpec
, amLang (explMarkup e) == l
, explForObj x (explObj e) -- informally: "if x and e are the same"
]
instance Motivated ConceptDef where
-- meaning _ cd = fatal 49 ("Concept definitions have no intrinsic meaning, (used with concept definition of '"++cdcpt cd++"')")
explForObj x (ExplConceptDef x') = x == x'
explForObj _ _ = False
explanations _ = []
instance Motivated A_Concept where
-- meaning _ c = fatal 54 ("Concepts have no intrinsic meaning, (used with concept '"++name c++"')")
explForObj x (ExplConceptDef cd) = name x == name cd
explForObj _ _ = False
explanations _ = []
instance Motivated Declaration where
-- meaning l decl = if null (decMean decl)
-- then concat [explCont expl | expl<-autoMeaning l decl, Just l == explLang expl || Nothing == explLang expl]
-- else decMean decl
explForObj d1 (ExplDeclaration d2) = d1 == d2
explForObj _ _ = False
explanations _ = []
-- autoMeaning lang d
-- = [Expl { explPos = decfpos d -- the position in the Ampersand script of this purpose definition
-- , explObj = ExplDeclaration d -- The object that is explained.
-- , explLang = Just lang -- The language of the explanation
-- , explRefId = "" -- The reference of the explaination
-- , explCont = [Para langInlines] -- The actual explanation
-- } ]
-- where
-- langInlines =
-- case lang of
-- English
-- | null ([Sym,Asy] >- multiplicities d) -> [Emph [Str (name d)]]
-- ++[Str " is a property of a "]
-- ++[Str ((unCap.name.source) d)]
-- ++[Str "."]
-- | null ([Sym,Rfx,Trn] >- multiplicities d) -> [Emph [Str (name d)]]
-- ++[Str " is an equivalence relation on "]
-- ++[Str ((unCap.plural English .name.source) d)]
-- ++[Str "."]
-- | null ([Asy,Trn] >- multiplicities d) -> [Emph [Str (name d)]]
-- ++[Str " is an ordering relation on "]
-- ++[Str ((unCap.plural English .name.source) d)]
-- ++[Str "."]
-- | null ([Uni,Tot,Inj,Sur] >- multiplicities d) -> applyM d [Str ("each "++(unCap.name.source) d)]
-- [Str ("exactly one "++(unCap.name.target) d)]
-- ++[Str " and vice versa."]
-- | null ([Uni,Tot,Inj ] >- multiplicities d) -> applyM d [Str ("each "++(unCap.name.source) d)]
-- [Str ("exactly one "++(unCap.name.target) d)]
-- ++[Str ", but not for each "]
-- ++[Str ((unCap.name.target) d++" there must be a "++(unCap.name.source) d)]
-- ++[Str "."]
-- | null ([Uni,Tot, Sur] >- multiplicities d) -> applyM d [Str ("each "++(unCap.name.source) d)]
-- [Str ("exactly one "++(unCap.name.target) d)]
-- ++[Str ", but each "]
-- ++[Str ((unCap.name.target) d++" is related to one or more "++(unCap.plural English .name.source) d)]
-- ++[Str "."]
-- | null ([Uni, Inj,Sur] >- multiplicities d) -> [Str ("There is exactly one "++(unCap.name.source) d++" (")]
-- ++[Math InlineMath "a"]
-- ++[Str (") for each "++(unCap.name.target) d++" (")]
-- ++[Math InlineMath "b"]
-- ++[Str "), for which: "]
-- ++applyM d [Math InlineMath "b"] [Math InlineMath "a"]
-- ++[Str (", but not for each "++(unCap.name.source) d++" there must be a "++(unCap.name.target) d++".")]
-- | null ([ Tot,Inj,Sur] >- multiplicities d) -> [Str ("There is exactly one "++(unCap.name.source) d++" (")]
-- ++[Math InlineMath "a"]
-- ++[Str (") for each "++(unCap.name.target) d++" (")]
-- ++[Math InlineMath "b"]
-- ++[Str "), for which: "]
-- ++applyM d [Math InlineMath "b"] [Math InlineMath "a"]
-- ++[Str (", but each "++(unCap.name.source) d++" is related to one or more "++(unCap.plural English .name.target) d)]
-- ++[Str "."]
-- | null ([Uni,Tot ] >- multiplicities d) -> applyM d [Str ("each "++(unCap.name.source) d)]
-- [Str ("exactly one "++(unCap.name.target) d)]
-- ++[Str "."]
-- | null ([Uni, Inj ] >- multiplicities d) -> applyM d [Str ("each "++(unCap.name.source) d)]
-- [Str ("at most one "++(unCap.name.target) d)]
-- ++[Str (" and each "++(unCap.name.target) d++" is related to at most one "++(unCap.name.source) d)]
-- ++[Str "."]
-- | null ([Uni, Sur] >- multiplicities d) -> applyM d [Str ("each "++(unCap.name.source) d)]
-- [Str ("at most one "++(unCap.name.target) d)]
-- ++[Str (", whereas each "++(unCap.name.target) d++" is related to at least one "++(unCap.name.source) d)]
-- ++[Str "."]
-- | null ([ Tot,Inj ] >- multiplicities d) -> applyM d [Str ("each "++(unCap.name.source) d)]
-- [Str ("at least one "++(unCap.name.target) d)]
-- ++[Str (", whereas each "++(unCap.name.target) d++" is related to at most one "++(unCap.name.source) d)]
-- ++[Str "."]
-- | null ([ Tot, Sur] >- multiplicities d) -> applyM d [Str ("each "++(unCap.name.source) d)]
-- [Str ("at least one "++(unCap.name.target) d)]
-- ++[Str (" and each "++(unCap.name.target) d++" is related to at least one "++(unCap.name.source) d)]
-- ++[Str "."]
-- | null ([ Inj,Sur] >- multiplicities d) -> [Str ("There is exactly one "++(unCap.name.source) d++" (")]
-- ++[Math InlineMath "a"]
-- ++[Str (") for each "++(unCap.name.target) d++" (")]
-- ++[Math InlineMath "b"]
-- ++[Str "), for which: "]
-- ++applyM d [Math InlineMath "b"] [Math InlineMath "a"]
-- ++[Str "."]
-- | null ([ Sur] >- multiplicities d) -> [Str ("There is at least one "++(unCap.name.source) d++" (")]
-- ++[Math InlineMath "a"]
-- ++[Str (") for each "++(unCap.name.target) d++" (")]
-- ++[Math InlineMath "b"]
-- ++[Str "), for which: "]
-- ++applyM d [Math InlineMath "b"] [Math InlineMath "a"]
-- ++[Str "."]
-- | null ([ Inj ] >- multiplicities d) -> [Str ("There is at most one "++(unCap.name.source) d++" (")]
-- ++[Math InlineMath "a"]
-- ++[Str (") for each "++(unCap.name.target) d++" (")]
-- ++[Math InlineMath "b"]
-- ++[Str "), for which: "]
-- ++applyM d [Math InlineMath "b"] [Math InlineMath "a"]
-- ++[Str "."]
-- | null ([ Tot ] >- multiplicities d) -> applyM d [Str ("each "++(unCap.name.source) d)]
-- [Str ("at least one "++(unCap.name.target) d)]
-- ++[Str "."]
-- | null ([Uni ] >- multiplicities d) -> applyM d [Str ("each "++(unCap.name.source) d)]
-- [Str ("zero or one "++(unCap.name.target) d)]
-- ++[Str "."]
-- | otherwise -> [Str "The sentence: "]
-- ++[Quoted DoubleQuote
-- (applyM d [Math InlineMath ((var [].source) d)]
-- [Math InlineMath ((var [source d].target) d)])
-- ]
-- ++[Str (" is meaningful (i.e. it is either true or false) for any "++(unCap.name.source) d++" ")]
-- ++[(Math InlineMath . var [] . source) d]
-- ++[Str (" and "++(unCap.name.target) d++" ")]
-- ++[(Math InlineMath . var [source d] . target) d]
-- ++[Str "."]
-- Dutch
-- | null ([Sym,Asy] >- multiplicities d) -> [Emph [Str (name d)]]
-- ++[Str " is een eigenschap van een "]
-- ++[Str ((unCap.name.source) d)]
-- ++[Str "."]
-- | null ([Sym,Rfx,Trn] >- multiplicities d) ->[Emph [Str (name d)]]
-- ++[Str " is een equivalentierelatie tussen "]
-- ++[Str ((unCap.plural Dutch .name.source) d)]
-- ++[Str "."]
-- | null ([Asy,Trn] >- multiplicities d) ->[Emph [Str (name d)]]
-- ++[Str " is een ordeningsrelatie tussen "]
-- ++[Str ((unCap.plural Dutch .name.source) d)]
-- ++[Str "."]
-- | null ([Uni,Tot,Inj,Sur] >- multiplicities d) -> applyM d [Str ("elke "++(unCap.name.source) d)]
-- [Str ("precies één "++(unCap.name.target) d)]
-- ++[Str " en vice versa."]
-- | null ([Uni,Tot,Inj] >- multiplicities d) -> applyM d [Str ("elke "++(unCap.name.source) d)]
-- [Str ("precies één "++(unCap.name.target) d)]
-- ++[Str ", maar niet voor elke "]
-- ++[Str ((unCap.name.target) d)]
-- ++[Str " hoeft er een "]
-- ++[Str ((unCap.name.source) d)]
-- ++[Str " te zijn."]
-- | null ([Uni,Tot, Sur] >- multiplicities d) -> applyM d [Str ("elke "++(unCap.name.source) d)]
-- [Str ("precies één "++(unCap.name.target) d)]
-- ++[Str ", maar elke "]
---- ++[Str ((unCap.name.target) d)]
-- ++[Str (" is gerelateerd aan één of meer ")]
-- ++[Str ((unCap.plural Dutch .name.source) d)]
-- ++[Str "."]
-- | null ([Uni, Inj,Sur] >- multiplicities d) -> [Str ("Er is precies één "++(unCap.name.source) d++" (")]
-- ++[Math InlineMath "a"]
-- ++[Str (") voor elke "++(unCap.name.target) d++" (")]
-- ++[Math InlineMath "b"]
-- ++[Str "), waarvoor geldt: "]
-- ++applyM d [Math InlineMath "b"] [Math InlineMath "a"]
-- ++[Str (", maar niet voor elke "++(unCap.name.source) d++" hoeft er een "++(unCap.name.target) d++" te zijn.")]
-- | null ([ Tot,Inj,Sur] >- multiplicities d) -> [Str ("Er is precies één "++(unCap.name.source) d++" (")]
-- ++[Math InlineMath "a"]
-- ++[Str (") voor elke "++(unCap.name.target) d++" (")]
-- ++[Math InlineMath "b"]
-- ++[Str "), waarvoor geldt: "]
-- ++applyM d [Math InlineMath "b"] [Math InlineMath "a"]
-- ++[Str (", maar elke "++(unCap.name.source) d++" mag gerelateerd zijn aan meerdere "++(unCap.plural Dutch .name.target) d++".")]
-- | null ([Uni,Tot ] >- multiplicities d) -> applyM d [Str ("elke "++(unCap.name.source) d)]
-- [Str ("precies één "++(unCap.name.target) d)]
-- ++[Str "."]
-- | null ([Uni, Inj ] >- multiplicities d) -> applyM d [Str ("elke "++(unCap.name.source) d)]
-- [Str ("ten hoogste één "++(unCap.name.target) d)]
-- ++[Str " en elke "]
-- ++[Str ((unCap.name.target) d)]
-- ++[Str (" is gerelateerd aan ten hoogste één ")]
-- ++[Str ((unCap.name.source) d++".")]
-- ++[Str "."]
-- | null ([Uni, Sur] >- multiplicities d) -> applyM d [Str ("elke "++(unCap.name.source) d)]
-- [Str ("ten hoogste één "++(unCap.name.target) d)]
-- ++[Str ", terwijl elke "]
-- ++[Str ((unCap.name.target) d)]
-- ++[Str (" is gerelateerd aan tenminste één ")]
-- ++[Str ((unCap.name.source) d)]
-- ++[Str "."]
-- | null ([ Tot,Inj ] >- multiplicities d) -> applyM d [Str ("elke "++(unCap.name.source) d)]
-- [Str ("tenminste één "++(unCap.name.target) d)]
-- ++[Str ", terwijl elke "]
-- ++[Str ((unCap.name.target) d)]
-- ++[Str (" is gerelateerd aan ten hoogste één ")]
-- ++[Str ((unCap.name.source) d)]
-- ++[Str "."]
-- | null ([ Tot, Sur] >- multiplicities d) -> applyM d [Str ("elke "++(unCap.name.source) d)]
-- [Str ("tenminste één "++(unCap.name.target) d)]
-- ++[Str (" en elke "++(unCap.name.target) d++" is gerelateerd aan tenminste één "++(unCap.name.source) d++".")]
-- | null ([ Inj,Sur] >- multiplicities d) -> [Str ("Er is precies één "++(unCap.name.source) d++" (")]
-- ++[Math InlineMath "a"]
-- ++[Str (") voor elke "++(unCap.name.target) d++" (")]
-- ++[Math InlineMath "b"]
-- ++[Str "), waarvoor geldt: "]
-- ++applyM d [Math InlineMath "b"] [Math InlineMath "a"]
-- ++[Str "."]
-- | null ([ Sur] >- multiplicities d) -> [Str ("Er is tenminste één "++(unCap.name.source) d++" (")]
-- ++[Math InlineMath "a"]
-- ++[Str (") voor elke "++(unCap.name.target) d++" (")]
-- ++[Math InlineMath "b"]
-- ++[Str "), waarvoor geldt: "]
-- ++applyM d [Math InlineMath "b"] [Math InlineMath "a"]
-- ++[Str "."]
-- | null ([ Inj ] >- multiplicities d) -> [Str ("Er is hooguit één "++(unCap.name.source) d++" (")]
-- ++[Math InlineMath "a"]
-- ++[Str (") voor elke "++(unCap.name.target) d++" (")]
-- ++[Math InlineMath "b"]
-- ++[Str "), waarvoor geldt: "]
-- ++applyM d [Math InlineMath "b"] [Math InlineMath "a"]
-- ++[Str "."]
-- | null ([ Tot ] >- multiplicities d) -> applyM d [Str ("elke "++(unCap.name.source) d)]
-- [Str ("tenminste één "++(unCap.name.target) d)]
-- ++[Str "."]
-- | null ([Uni ] >- multiplicities d) -> applyM d [Str ("elke "++(unCap.name.source) d)]
-- [Str ("nul of één "++(unCap.name.target) d)]
-- ++[Str "."]
-- | otherwise -> [Str "De zin: "]
-- ++[Quoted DoubleQuote
-- (applyM d [(Math InlineMath . var [] . source) d]
-- [(Math InlineMath . var [source d] . target) d])
-- ]
-- ++[Str (" heeft betekenis (dus: is waar of niet waar) voor een "++(unCap.name.source) d++" ")]
-- ++[(Math InlineMath . var [].source) d]
-- ++[Str (" en een "++(unCap.name.target) d++" ")]
-- ++[(Math InlineMath . var [source d].target) d]
-- ++[Str "."]
--
-- applyM :: Declaration -> [Inline] -> [Inline] -> [Inline]
-- applyM decl a b =
-- case decl of
-- Sgn{} | null (prL++prM++prR)
-- -> a++[Space,Str "corresponds",Space,Str "to",Space]++b++[Space,Str "in",Space,Str "relation",Space,Str(decnm decl)]
-- | null prL
-- -> a++[Space,Str prM,Space]++b++[Space,Str prR]
-- | otherwise
-- -> [Str (upCap prL),Space]++a++[Space,Str prM,Space]++b++if null prR then [] else [Space,Str prR]
-- where prL = decprL decl
-- prM = decprM decl
-- prR = decprR decl
-- Isn{} -> a++[Space,Str "equals",Space]++b
-- Vs{} -> [Str (show True)]
--
-- var :: Identified a => [a] -> a -> String -- TODO Vervangen door mkvar, uit predLogic.hs
-- var seen c = low c ++ ['\'' | c'<-seen, low c == low c']
-- where low idt= if null (name idt) then "x" else [(toLower.head.name) idt]
instance Motivated Rule where
-- meaning l rule
-- = head (expls++map explCont (autoMeaning l rule))
-- where
-- expls = [econt | Means l' econt<-rrxpl rule, l'==Just l || l'==Nothing]
explForObj x (ExplRule str) = name x == str
explForObj _ _ = False
explanations _ = []
-- autoMeaning lang r
-- = [Expl { explObj = ExplRule (name r) -- The object that is explained.
-- , explPos = origin r
-- , explLang = Just lang -- The language of the explaination
-- , explRefId = "" -- The reference of the explaination
-- , explCont = [Plain [RawInline (Text.Pandoc.Builder.Format "latex") (showPredLogic lang r++".")]] -- The actual explanation.
-- } ]
instance Motivated Theme where
explForObj (PatternTheme pat) eo = explForObj pat eo
explForObj (ProcessTheme prc) eo = explForObj prc eo
explanations (PatternTheme pat) = explanations pat
explanations (ProcessTheme prc) = explanations prc
instance Motivated Pattern where
-- meaning _ pat = fatal 324 ("Patterns have no intrinsic meaning, (used with pattern '"++name pat++"')")
explForObj x (ExplPattern str) = name x == str
explForObj _ _ = False
explanations = ptxps
instance Motivated Process where
-- meaning _ prc = fatal 329 ("Processes have no intrinsic meaning, (used with process '"++name prc++"')")
explForObj x (ExplProcess str) = name x == str
explForObj _ _ = False
explanations = prcXps
instance Motivated Interface where
-- meaning _ obj = fatal 342 ("Interfaces have no intrinsic meaning, (used with interface '"++name obj++"')")
explForObj x (ExplInterface str) = name x == str
explForObj _ _ = False
explanations _ = []
class Meaning a where
meaning :: Lang -> a -> Maybe A_Markup
meaning2Blocks :: Lang -> a -> [Block]
meaning2Blocks l a = case meaning l a of
Nothing -> []
Just m -> amPandoc m
instance Meaning Rule where
meaning l r = case filter isLang (ameaMrk (rrmean r)) of
[] -> Nothing
[m] -> Just m
_ -> fatal 381 ("Too many meanings given for rule "++name r ++".")
where isLang m = l == amLang m
instance Meaning Declaration where
meaning l d = case filter isLang (ameaMrk (decMean d)) of
[] -> Nothing
[m] -> Just m
_ -> fatal 388 ("Too many meanings given for declaration "++name d ++".")
where isLang m = l == amLang m
instance Motivated Fspc where
-- meaning _ fSpec = fatal 329 ("No Fspc has an intrinsic meaning, (used with Fspc '"++name fSpec++"')")
explForObj x (ExplContext str) = name x == str
explForObj _ _ = False
explanations fSpec
= fSexpls fSpec ++
(concatMap explanations . vpatterns) fSpec ++
(concatMap explanations . vprocesses) fSpec ++
(concatMap explanations . interfaceS) fSpec
instance Motivated FProcess where
-- meaning l fp = meaning l (proc fp)
explForObj fp = explForObj (fpProc fp)
explanations fp = explanations (fpProc fp)
-- Ampersand allows multiple purposes for everything.
-- The diagnosis report must make mention of this (so the user will notice if (s)he reads the diagnosis).
-- Multiple purposes are simply concatenated, so the user sees them all.
instance Motivated Activity where
explForObj _ _ = False
explanations activity = actPurp activity
purposeOf _ l x = case [ e | e <- actPurp x, amLang (explMarkup e) == l ] of
[] -> Nothing
purps -> Just purps