ampersand-3.0.2: Toolsuite for automated design of business processes.

Safe HaskellNone

DatabaseDesign.Ampersand

Contents

Synopsis

Documentation

data P_Context Source

Constructors

PCtx 

Fields

ctx_nm :: String

The name of this context

ctx_pos :: [Origin]

The origin of the context. A context can be a merge of a file including other files c.q. a list of Origin.

ctx_lang :: Maybe Lang

The default language specified by this context, if specified at all.

ctx_markup :: Maybe PandocFormat

The default markup format for free text in this context

ctx_thms :: [String]

Names of patterns/processes to be printed in the functional specification. (For partial documents.)

ctx_pats :: [P_Pattern]

The patterns defined in this context

ctx_PPrcs :: [P_Process]

The processes as defined by the parser

ctx_rs :: [P_Rule TermPrim]

All user defined rules in this context, but outside patterns and outside processes

ctx_ds :: [P_Declaration]

The relations defined in this context, outside the scope of patterns

ctx_cs :: [ConceptDef]

The concept definitions defined in this context, outside the scope of patterns

ctx_ks :: [P_IdentDef]

The identity definitions defined in this context, outside the scope of patterns

ctx_vs :: [P_ViewDef]

The view definitions defined in this context, outside the scope of patterns

ctx_gs :: [P_Gen]

The gen definitions defined in this context, outside the scope of patterns

ctx_ifcs :: [P_Interface]

The interfaces defined in this context, outside the scope of patterns

ctx_ps :: [PPurpose]

The purposes defined in this context, outside the scope of patterns

ctx_pops :: [P_Population]

The populations defined in this context

ctx_sql :: [P_ObjectDef]

user defined sqlplugs, taken from the Ampersand script

ctx_php :: [P_ObjectDef]

user defined phpplugs, taken from the Ampersand script

ctx_metas :: [Meta]

generic meta information (name/value pairs) that can be used for experimenting without having to modify the adl syntax

data P_Rule a Source

Constructors

P_Ru 

Fields

rr_nm :: String

Name of this rule

rr_exp :: Term a

The rule expression

rr_fps :: Origin

Position in the Ampersand file

rr_mean :: [PMeaning]

User-specified meanings, possibly more than one, for multiple languages.

rr_msg :: [PMessage]

User-specified violation messages, possibly more than one, for multiple languages.

rr_viol :: Maybe (PairView (Term a))

Custom presentation for violations, currently only in a single language

data Term a Source

Constructors

Prim a 
Pequ Origin (Term a) (Term a)

equivalence =

Pimp Origin (Term a) (Term a)

implication |-

PIsc Origin (Term a) (Term a)

intersection /

PUni Origin (Term a) (Term a)

union /

PDif Origin (Term a) (Term a)

difference -

PLrs Origin (Term a) (Term a)

left residual /

PRrs Origin (Term a) (Term a)

right residual

PDia Origin (Term a) (Term a)

diamond

PCps Origin (Term a) (Term a)

composition ;

PRad Origin (Term a) (Term a)

relative addition !

PPrd Origin (Term a) (Term a)

cartesian product *

PKl0 Origin (Term a)

Rfx.Trn closure * (Kleene star)

PKl1 Origin (Term a)

Transitive closure + (Kleene plus)

PFlp Origin (Term a)

conversion (flip, wok) ~

PCpl Origin (Term a)

Complement

PBrk Origin (Term a)

bracketed expression ( ... )

Instances

data TermPrim Source

Constructors

PI Origin

identity element without a type At parse time, there may be zero or one element in the list of concepts. Reason: when making eqClasses, the least element of that class is used as a witness of that class to know whether an eqClass represents a concept, we only look at its witness By making Pid the first in the data decleration, it becomes the least element for deriving Ord.

Pid Origin P_Concept

identity element restricted to a type

Patm Origin String (Maybe P_Concept)

an atom, possibly with a type

PVee Origin

the complete relation, of which the type is yet to be derived by the type checker.

Pfull Origin P_Concept P_Concept

the complete relation, restricted to a type. At parse time, there may be zero, one or two elements in the list of concepts.

Prel Origin String

we expect expressions in flip-normal form

PTrel Origin String P_Sign

type cast expression

data P_Sign Source

Constructors

P_Sign 

Fields

pSrc :: P_Concept
 
pTgt :: P_Concept
 

Instances

data P_Concept Source

Constructors

PCpt

The name of this Concept

Fields

p_cptnm :: String
 
P_Singleton 

data P_Declaration Source

Constructors

P_Sgn 

Fields

dec_nm :: String

the name of the declaration

dec_sign :: P_Sign

the type. Parser must guarantee it is not empty.

dec_prps :: Props

the user defined multiplicity properties (Uni, Tot, Sur, Inj) and algebraic properties (Sym, Asy, Trn, Rfx)

dec_prL :: String

three strings, which form the pragma. E.g. if pragma consists of the three strings: Person , is married to person , and in Vegas.

dec_prM :: String

then a tuple (Peter,Jane) in the list of links means that Person Peter is married to person Jane in Vegas.

dec_prR :: String
 
dec_Mean :: [PMeaning]

the optional meaning of a declaration, possibly more than one for different languages.

dec_popu :: Pairs

the list of tuples, of which the relation consists.

dec_fpos :: Origin

the position in the Ampersand source file where this declaration is declared. Not all decalartions come from the ampersand souce file.

dec_plug :: Bool

if true, this relation may not be stored in or retrieved from the standard database (it should be gotten from a Plug of some sort instead)

data P_Pattern Source

Constructors

P_Pat 

Fields

pt_nm :: String

Name of this pattern

pt_pos :: Origin

the starting position in the file in which this pattern was declared.

pt_end :: Origin

the end position in the file in which this pattern was declared.

pt_rls :: [P_Rule TermPrim]

The user defined rules in this pattern

pt_gns :: [P_Gen]

The generalizations defined in this pattern

pt_dcs :: [P_Declaration]

The relations that are declared in this pattern

pt_rus :: [RoleRule]

The assignment of roles to rules.

pt_res :: [P_RoleRelation]

The assignment of roles to Relations.

pt_cds :: [ConceptDef]

The concept definitions defined in this pattern

pt_ids :: [P_IdentDef]

The identity definitions defined in this pattern

pt_vds :: [P_ViewDef]

The view definitions defined in this pattern

pt_xps :: [PPurpose]

The purposes of elements defined in this pattern

pt_pop :: [P_Population]

The populations that are local to this pattern

data P_Gen Source

Constructors

P_Cy 

Fields

gen_spc :: P_Concept

specific concept

Left hand side concept expression

gen_rhs :: [P_Concept]

Right hand side concept expression

gen_fp :: Origin

the position of the GEN-rule

Position in the Ampersand file

PGen 

Fields

gen_spc :: P_Concept

specific concept

Left hand side concept expression

gen_gen :: P_Concept

generic concept

gen_fp :: Origin

the position of the GEN-rule

Position in the Ampersand file

Instances

newtype PMeaning Source

Constructors

PMeaning P_Markup 

Instances

data Meta Source

Constructors

Meta 

data MetaObj Source

Constructors

ContextMeta 

data A_Concept Source

Constructors

PlainConcept

PlainConcept nm represents the set of instances cs by name nm.

Fields

cptnm :: String
 
ONE

The universal Singleton: I[Anything] = V['Anything'*'Anything']

data A_Gen Source

data structure A_Gen contains the CLASSIFY statements from an Ampersand script CLASSIFY Employee ISA Person translates to Isa (C Person) (C Employee) CLASSIFY Workingstudent IS Employee/Student translates to IsE orig (C Workingstudent) [C Employee,C Student]

Constructors

Isa 

Fields

genspc :: A_Concept

specific concept

specific concept

gengen :: A_Concept

generic concept

IsE 

Fields

genspc :: A_Concept

specific concept

specific concept

genrhs :: [A_Concept]

concepts of which the conjunction is equivalent to the specific concept

data ConceptDef Source

Constructors

Cd 

Fields

cdpos :: Origin

The position of this definition in the text of the Ampersand source (filename, line number and column number).

cdcpt :: String

The name of the concept for which this is the definition. If there is no such concept, the conceptdefinition is ignored.

cdplug :: Bool

Whether the user specifically told Ampersand not to store this concept in the database

cddef :: String

The textual definition of this concept.

cdtyp :: String

The (SQL) type of this concept.

cdref :: String

A label meant to identify the source of the definition. (useful as LaTeX' symbolic reference)

cdfrom :: String

The name of the pattern or context in which this concept definition was made

class ConceptStructure a whereSource

Methods

concsSource

Arguments

:: a 
-> [A_Concept]

the set of all concepts used in data structure a

relsUsedInSource

Arguments

:: a 
-> [Declaration]

the set of all declaratons used within data structure a. `used within` means that there is a relation that refers to that declaration.

relsMentionedInSource

Arguments

:: a 
-> [Declaration]

the set of all declaratons used within data structure a. `used within` means that there is a relation that refers to that declaration.

primsMentionedIn :: a -> [Expression]Source

expressionsInSource

Arguments

:: a 
-> [Expression]

The set of all expressions within data structure a

mp1ExprsSource

Arguments

:: a 
-> [Expression]

the set of all EMp1 expressions within data structure a (needed to get the atoms of these relations into the populationtable)

mp1Pops :: a -> [Population]Source

mp1Pops draws the population from singleton expressions.

data Activity Source

Constructors

Act 

Instances

Eq Activity 
Identified Activity 
ConceptStructure Activity

A Quad is used in the switchboard of rules. It represents a proto-rule with the following meaning: whenever qRel is affected (i.e. tuples in qRel are inserted or deleted), qRule may have to be restored using functionality from qClauses. The rule is taken along for traceability.

ShowHS Activity 
Motivated Activity 

data AMeaning Source

Constructors

AMeaning 

Fields

ameaMrk :: [A_Markup]
 

data Quad Source

Constructors

Quad 

data Fswitchboard Source

A list of ECA rules, which is used for automated functionality.

Constructors

Fswtch 

Fields

fsbEvIn :: [Event]
 
fsbEvOut :: [Event]
 
fsbConjs :: [(Rule, Expression)]
 
fsbECAs :: [ECArule]
 

Instances

data Event Source

Constructors

On 

Fields

eSrt :: InsDel
 
eDcl :: Declaration
 

data InsDel Source

Constructors

Ins 
Del 

data Pattern Source

Constructors

A_Pat 

Fields

ptnm :: String

Name of this pattern

ptpos :: Origin

the position in the file in which this pattern was declared.

ptend :: Origin

the end position in the file, elements with a position between pos and end are elements of this pattern.

ptrls :: [Rule]

The user defined rules in this pattern

ptgns :: [A_Gen]

The generalizations defined in this pattern

ptdcs :: [Declaration]

The relations that are declared in this pattern

ptups :: [Population]

The user defined populations in this pattern

ptrruls :: [(String, Rule)]

The assignment of roles to rules.

ptrrels :: [(String, Declaration)]

The assignment of roles to Relations.

ptids :: [IdentityDef]

The identity definitions defined in this pattern

ptvds :: [ViewDef]

The view definitions defined in this pattern

ptxps :: [Purpose]

The purposes of elements defined in this pattern

data Declaration Source

Constructors

Sgn 

Fields

decnm :: String

the name of the declaration

decsgn :: Sign

the source and target concepts of the declaration multiplicities returns decprps_calc, when it has been calculated. So if you only need the user defined properties do not use multiplicities but decprps

decprps :: [Prop]

the user defined multiplicity properties (Uni, Tot, Sur, Inj) and algebraic properties (Sym, Asy, Trn, Rfx)

decprps_calc :: Maybe [Prop]

the calculated and user defined multiplicity properties (Uni, Tot, Sur, Inj) and algebraic properties (Sym, Asy, Trn, Rfx, Irf). Note that calculated properties are made by adl2fspec, so in the A-structure decprps and decprps_calc yield exactly the same answer.

decprL :: String

three strings, which form the pragma. E.g. if pragma consists of the three strings: Person , is married to person , and in Vegas.

decprM :: String

then a tuple (Peter,Jane) in the list of links means that Person Peter is married to person Jane in Vegas.

decprR :: String
 
decMean :: AMeaning

the meaning of a declaration, for each language supported by Ampersand.

decfpos :: Origin

the position in the Ampersand source file where this declaration is declared. Not all decalartions come from the ampersand souce file.

deciss :: Bool

if true, this is a signal relation; otherwise it is an ordinary relation.

decusr :: Bool

if true, this relation is declared by an author in the Ampersand script; otherwise it was generated by Ampersand.

decpat :: String

the pattern where this declaration has been declared.

decplug :: Bool

if true, this relation may not be stored in or retrieved from the standard database (it should be gotten from a Plug of some sort instead)

Isn 

Fields

detyp :: A_Concept

The type

Vs 

Fields

decsgn :: Sign

the source and target concepts of the declaration multiplicities returns decprps_calc, when it has been calculated. So if you only need the user defined properties do not use multiplicities but decprps

data IdentityDef Source

Constructors

Id 

Fields

idPos :: Origin

position of this definition in the text of the Ampersand source file (filename, line number and column number).

idLbl :: String

the name (or label) of this Identity. The label has no meaning in the Compliant Service Layer, but is used in the generated user interface. It is not an empty string.

idCpt :: A_Concept

this expression describes the instances of this object, related to their context

identityAts :: [IdentitySegment]

the constituent attributes (i.e. name/expression pairs) of this identity.

data ViewDef Source

Constructors

Vd 

Fields

vdpos :: Origin

position of this definition in the text of the Ampersand source file (filename, line number and column number).

vdlbl :: String

the name (or label) of this View. The label has no meaning in the Compliant Service Layer, but is used in the generated user interface. It is not an empty string.

vdcpt :: A_Concept

this expression describes the instances of this object, related to their context

vdats :: [ViewSegment]

the constituent attributes (i.e. name/expression pairs) of this view.

data Expression Source

Constructors

EEqu (Expression, Expression)

equivalence =

EImp (Expression, Expression)

implication |-

EIsc (Expression, Expression)

intersection /\

EUni (Expression, Expression)

union /

EDif (Expression, Expression)

difference -

ELrs (Expression, Expression)

left residual /

ERrs (Expression, Expression)

right residual \

EDia (Expression, Expression)

diamond

ECps (Expression, Expression)

composition ;

ERad (Expression, Expression)

relative addition !

EPrd (Expression, Expression)

cartesian product *

EKl0 Expression

Rfx.Trn closure * (Kleene star)

EKl1 Expression

Transitive closure + (Kleene plus)

EFlp Expression

conversion (flip, wok) ~

ECpl Expression

Complement

EBrk Expression

bracketed expression ( ... )

EDcD Declaration

simple declaration

EDcI A_Concept

Identity relation

EEps A_Concept Sign

Epsilon relation (introduced by the system to ensure we compare concepts by equality only.

EDcV Sign

Cartesian product relation

EMp1 String A_Concept

constant (string between single quotes)

data Fspc Source

Constructors

Fspc 

Fields

fsName :: String

The name of the specification, taken from the Ampersand script

fspos :: [Origin]

The origin of the Fspc. An Fspc can be a merge of a file including other files c.q. a list of Origin.

themes :: [String]

The names of patterns/processes to be printed in the functional specification. (for making partial documentation)

pattsInScope :: [Pattern]
 
procsInScope :: [Process]
 
rulesInScope :: [Rule]
 
declsInScope :: [Declaration]
 
concsInScope :: [A_Concept]
 
cDefsInScope :: [ConceptDef]
 
gensInScope :: [A_Gen]
 
fsLang :: Lang

The default language for this specification (always specified, so no Maybe here!).

vprocesses :: [FProcess]

All processes defined in the Ampersand script

vplugInfos :: [PlugInfo]

All plugs defined in the Ampersand script

plugInfos :: [PlugInfo]

All plugs (defined and derived)

interfaceS :: [Interface]

All interfaces defined in the Ampersand script

interfaceG :: [Interface]

All interfaces derived from the basic ontology (the Lonneker interface)

fSwitchboard :: Fswitchboard

The code to be executed to maintain the truth of invariants

fActivities :: [Activity]

generated: One Activity for every ObjectDef in interfaceG and interfaceS

fRoleRels :: [(String, Declaration)]

the relation saying which roles may change the population of which relation.

fRoleRuls :: [(String, Rule)]

the relation saying which roles may change the population of which relation.

fRoles :: [String]

All roles mentioned in this context.

vrules :: [Rule]

All user defined rules that apply in the entire Fspc

grules :: [Rule]

All rules that are generated: multiplicity rules and identity rules

invars :: [Rule]

All invariant rules

allRules :: [Rule]

All rules, both generated (from multiplicity and keys) as well as user defined ones.

allUsedDecls :: [Declaration]

All relations that are used in the fSpec

allDecls :: [Declaration]

All relations that are declared in the fSpec

vrels :: [Declaration]

All user defined and generated relations plus all defined and computed totals. The generated relations are all generalizations and one declaration for each signal.

allConcepts :: [A_Concept]

All concepts in the fSpec

kernels :: [[A_Concept]]

All concepts, grouped by their classifications

vIndices :: [IdentityDef]

All keys that apply in the entire Fspc

vviews :: [ViewDef]

All views that apply in the entire Fspc

vgens :: [A_Gen]

All gens that apply in the entire Fspc

vconjs :: [RuleClause]

All conjuncts generated (by ADL2Fspec)

vquads :: [Quad]

All quads generated (by ADL2Fspec)

vEcas :: [ECArule]

All ECA rules generated (by ADL2Fspec)

fsisa :: [(A_Concept, A_Concept)]

generated: The data structure containing the generalization structure of concepts

vpatterns :: [Pattern]

All patterns taken from the Ampersand script

conceptDefs :: [ConceptDef]

All concept definitions defined throughout a context, including those inside patterns and processes

fSexpls :: [Purpose]

All purposes that have been declared at the top level of the current specification, but not in the processes, patterns and interfaces.

metas :: [Meta]

All meta relations from the entire context

initialPops :: [Population]
 
allViolations :: [(Rule, [Paire])]
 

data PlugSQL Source

Constructors

TblSQL

stores a related collection of relations: a kernel of concepts and attribute relations of this kernel i.e. a list of SqlField given some A -> [target r | r::A*B,isUni r,isTot r, isInj r] ++ [target r | r::A*B,isUni r, not(isTot r), not(isSur r)] kernel = A closure of concepts A,B for which there exists a r::A->B[INJ] (r=fldexpr of kernel field holding instances of B, in practice r is I or a makeRelation(flipped declaration)) attribute relations = All concepts B, A in kernel for which there exists a r::A*B[UNI] and r not TOT and SUR (r=fldexpr of attMor field, in practice r is a makeRelation(declaration))

Fields

sqlname :: String
 
fields :: [SqlField]

the first field is the concept table of the most general concept (e.g. Person) then follow concept tables of specializations. Together with the first field this is called the kernel the remaining fields represent attributes.

cLkpTbl :: [(A_Concept, SqlField)]

lookup table that links all kernel concepts to fields in the plug cLkpTbl is een lijst concepten die in deze plug opgeslagen zitten, en hoe je ze eruit kunt halen

mLkpTbl :: [(Expression, SqlField, SqlField)]

lookup table that links concepts to column names in the plug (kernel+attRels) mLkpTbl is een lijst met relaties die in deze plug opgeslagen zitten, en hoe je ze eruit kunt halen

BinSQL

stores one relation r in two ordered columns i.e. a tuple of SqlField -> (source r,target r) with (fldexpr=I/r;r~, fldexpr=r) (note: if r TOT then (I/r;r~ = I). Thus, the concept (source r) is stored in this plug too) with tblcontents = [[Just x,Just y] |(x,y)<-contents r]. Typical for BinSQL is that it has exactly two columns that are not unique and may not contain NULL values

Fields

sqlname :: String
 
columns :: (SqlField, SqlField)
 
cLkpTbl :: [(A_Concept, SqlField)]

lookup table that links all kernel concepts to fields in the plug cLkpTbl is een lijst concepten die in deze plug opgeslagen zitten, en hoe je ze eruit kunt halen

mLkp :: Expression
 
ScalarSQL

stores one concept c in one column i.e. a SqlField -> c with tblcontents = [[Just x] |(x,_)<-contents c]. Typical for ScalarSQL is that it has exactly one column that is unique and may not contain NULL values i.e. fldexpr=I[c]

Instances

Eq PlugSQL 
Ord PlugSQL 
Show PlugSQL 
Identified PlugSQL 
Object PlugSQL 
ConceptStructure PlugSQL 
FPAble PlugSQL 
Plugable PlugSQL 
ShowHS PlugSQL 
ShowHSName PlugSQL

The following is used to showHS flags for signs: (Concept, Concept) instance (ShowHS a , ShowHS b) => ShowHS (a,b) where showHS flags indent (a,b) = (++showHS flags (indent++ ) a++,++showHS flags (indent++ ) b++)

data SqlField Source

Constructors

Fld 

Fields

fldname :: String
 
fldexpr :: Expression

De target van de expressie geeft de waarden weer in de SQL-tabel-kolom.

fldtype :: SqlType
 
flduse :: SqlFieldUsage
 
fldnull :: Bool

True if there can be empty field-values (intended for data dictionary of DB-implementation)

flduniq :: Bool

True if all field-values are unique? (intended for data dictionary of DB-implementation)

data PAclause Source

Constructors

CHC 

Fields

paCls :: [PAclause]
 
paMotiv :: [(Expression, [Rule])]
 
GCH 

Fields

paGCls :: [(InsDel, Expression, PAclause)]
 
paMotiv :: [(Expression, [Rule])]
 
ALL 

Fields

paCls :: [PAclause]
 
paMotiv :: [(Expression, [Rule])]
 
Do 
New 

Fields

paCpt :: A_Concept
 
paCl :: String -> PAclause
 
paMotiv :: [(Expression, [Rule])]
 
Rmv 

Fields

paCpt :: A_Concept
 
paCl :: String -> PAclause
 
paMotiv :: [(Expression, [Rule])]
 
Nop 

Fields

paMotiv :: [(Expression, [Rule])]
 
Blk 

Fields

paMotiv :: [(Expression, [Rule])]
 
Let 
Ref 

Fields

paVar :: String
 

data Rule Source

Constructors

Ru 

Fields

rrnm :: String

Name of this rule

rrexp :: Expression

The rule expression

rrfps :: Origin

Position in the Ampersand file

rrmean :: AMeaning

Ampersand generated meaning (for all known languages)

rrmsg :: [A_Markup]

User-specified violation messages, possibly more than one, for multiple languages.

rrviol :: Maybe (PairView Expression)

Custom presentation for violations, currently only in a single language

rrtyp :: Sign

Allocated type

rrdcl :: Maybe (Prop, Declaration)

The property, if this rule originates from a property on a Declaration

r_env :: String

Name of pattern in which it was defined.

r_usr :: RuleOrigin

Where does this rule come from?

isSignal :: Bool

True if this is a signal; False if it is an invariant

srrel :: Declaration

the signal relation

data Process Source

Constructors

Proc 

Fields

prcNm :: String
 
prcPos :: Origin
 
prcEnd :: Origin

the end position in the file, elements with a position between pos and end are elements of this process.

prcRules :: [Rule]
 
prcGens :: [A_Gen]
 
prcDcls :: [Declaration]
 
prcUps :: [Population]

The user defined populations in this process

prcRRuls :: [(String, Rule)]

The assignment of roles to rules.

prcRRels :: [(String, Declaration)]

The assignment of roles to Relations.

prcIds :: [IdentityDef]

The identity definitions defined in this process

prcVds :: [ViewDef]

The view definitions defined in this process

prcXps :: [Purpose]

The motivations of elements defined in this process

data Prop Source

Constructors

Uni

univalent

Inj

injective

Sur

surjective

Tot

total

Sym

symmetric

Asy

antisymmetric

Trn

transitive

Rfx

reflexive

Irf

irreflexive

data Lang Source

Constructors

Dutch 
English 

Instances

data Clauses Source

Constructors

Clauses 

Fields

cl_conjNF :: [RuleClause]
 
cl_rule :: Rule
 

data Picture Source

Constructors

Pict 

Fields

pType :: PictureReq

the type of the picture

scale :: String

a scale factor, intended to pass on to LaTeX, because Pandoc seems to have a problem with scaling.

dotSource :: DotGraph String

the string representing the .dot

dotProgName :: GraphvizCommand

the name of the program to use (dot or neato or fdp or Sfdp)

caption :: String

a human readable name of this picture

data Pos Source

Constructors

Pos !Line !Column 

Instances

data FPA Source

Constructors

FPA 

Fields

fpType :: FPtype
 
complexity :: FPcompl
 

Instances

Classes:

flp :: Flippable a => a -> aSource

class Collection a whereSource

Methods

eleM :: Eq b => b -> a b -> BoolSource

uni, isc :: Eq b => a b -> a b -> a bSource

(>-) :: Eq b => a b -> a b -> a bSource

empty :: Eq b => a bSource

elems :: Eq b => a b -> [b]Source

Instances

class ProcessStructure a whereSource

Methods

processesSource

Arguments

:: a 
-> [Process]

all roles that are used in this ProcessStructure

rolesSource

Arguments

:: a 
-> [String]

all roles that are used in this ProcessStructure

interfacesSource

Arguments

:: a 
-> [Interface]

all interfaces that are used in this ProcessStructure

objDefs :: a -> [ObjectDef]Source

processRulesSource

Arguments

:: a 
-> [Rule]

all process rules that are visible within this viewpoint ^ all relations used in rules must have a valid declaration in the same viewpoint.

maintainsSource

Arguments

:: a 
-> [(String, Rule)]

the string represents a Role

mayEditSource

Arguments

:: a 
-> [(String, Declaration)]

the string represents a Role

workFromProcessRules :: [A_Gen] -> [Population] -> a -> [(Rule, Paire)]Source

data ObjectDef Source

Constructors

Obj 

Fields

objnm :: String

view name of the object definition. The label has no meaning in the Compliant Service Layer, but is used in the generated user interface if it is not an empty string.

objpos :: Origin

position of this definition in the text of the Ampersand source file (filename, line number and column number)

objctx :: Expression

this expression describes the instances of this object, related to their context.

objmsub :: Maybe SubInterface

the attributes, which are object definitions themselves.

objstrs :: [[String]]

directives that specify the interface.

class (Identified p, Eq p, Show p) => Plugable p whereSource

Methods

makePlug :: PlugInfo -> pSource

Instances

class Identified a => Motivated a whereSource

Methods

purposeOfSource

Arguments

:: 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.

explForObjSource

Arguments

:: a 
-> ExplObj 
-> Bool

Given an Explainable object and an ExplObj, return TRUE if they concern the identical object.

explanationsSource

Arguments

:: a 
-> [Purpose]

The explanations that are defined inside a (including that of a itself)

purposesDefinedInSource

Arguments

:: Fspc 
-> Lang 
-> a 
-> [Purpose]

The explanations that are defined inside a (including that of a itself)

class Language a whereSource

Methods

objectdefSource

Arguments

:: a 
-> ObjectDef

The objectdef that characterizes this viewpoint

relsDefdInSource

Arguments

:: a 
-> [Declaration]

all relations that are declared in the scope of this viewpoint. These are user defined relations and all generated relarations, i.e. one relation for each GEN and one for each signal rule. Don't confuse relsDefdIn with relsUsedIn, which gives the relations that are used in a.)

udefrulesSource

Arguments

:: a 
-> [Rule]

all user defined rules that are maintained within this viewpoint, which are not multiplicity- and not identity rules.

invariantsSource

Arguments

:: a 
-> [Rule]

all rules that are not maintained by users will be maintained by the computer. That includes multiplicity rules and identity rules, but excludes rules that are assigned to a role. ^ all relations used in rules must have a valid declaration in the same viewpoint.

multrulesSource

Arguments

:: a 
-> [Rule]

all multiplicityrules that are maintained within this viewpoint.

identityRules :: a -> [Rule]Source

identitiesSource

Arguments

:: a 
-> [IdentityDef]

all keys that are defined in a

viewDefsSource

Arguments

:: a 
-> [ViewDef]

all views that are defined in a

gensSource

Arguments

:: a 
-> [A_Gen]

all generalizations that are valid within this viewpoint

patternsSource

Arguments

:: a 
-> [Pattern]

all patterns that are used in this viewpoint

class FPAble a whereSource

Methods

fpa :: a -> FPASource

fPoints :: a -> IntSource

showFPA :: Lang -> a -> StringSource

class ShowHSName a whereSource

Methods

showHSName :: a -> StringSource

Instances

ShowHSName Char 
ShowHSName Origin 
ShowHSName Prop 
ShowHSName A_Concept 
ShowHSName ObjectDef 
ShowHSName Interface 
ShowHSName ViewDef 
ShowHSName IdentityDef 
ShowHSName Declaration 
ShowHSName Rule 
ShowHSName Pattern 
ShowHSName Process 
ShowHSName SqlField 
ShowHSName PlugSQL

The following is used to showHS flags for signs: (Concept, Concept) instance (ShowHS a , ShowHS b) => ShowHS (a,b) where showHS flags indent (a,b) = (++showHS flags (indent++ ) a++,++showHS flags (indent++ ) b++)

ShowHSName PlugInfo 
ShowHSName RuleClause 
ShowHSName ECArule 
ShowHSName Quad 
ShowHSName FProcess 
ShowHSName Fspc 
ShowHSName a => ShowHSName [a] 
ShowHSName a => ShowHSName (Maybe a) 
(ShowHSName a, ShowHSName b) => ShowHSName (a, b) 

Functions on concepts

(<==>) :: Poset a => a -> a -> BoolSource

Is comparable to.

meet :: Sortable a => a -> a -> aSource

join :: Sortable a => a -> a -> aSource

sortWith :: (Show b, Poset b) => (b -> [[b]], [b]) -> (a -> b) -> [a] -> [a]Source

atomsOf :: [A_Gen] -> [Population] -> A_Concept -> [String]Source

This function returns the atoms of a concept (like fullContents does for relation-like things.)

smallerConcepts :: [A_Gen] -> A_Concept -> [A_Concept]Source

this function takes all generalisation relations from the context and a concept and delivers a list of all concepts that are more specific than the given concept. If there are no cycles in the generalization graph, cpt cannot be an element of smallerConcepts gens cpt.

largerConcepts :: [A_Gen] -> A_Concept -> [A_Concept]Source

this function takes all generalisation relations from the context and a concept and delivers a list of all concepts that are more generic than the given concept.

rootConcepts :: [A_Gen] -> [A_Concept] -> [A_Concept]Source

this function returns the most generic concepts in the class of a given concept

Functions on relations

Functions on rules

Functions on expressions:

lookupCpt :: Fspc -> A_Concept -> [(PlugSQL, SqlField)]Source

This returns all columntable pairs that serve as a concept table for cpt. When addingremoving atoms, all of these columns need to be updated

showPrf :: (expr -> String) -> Proof expr -> [String]Source

foldrMapExpression :: (r -> a -> a) -> (Declaration -> r) -> a -> Expression -> aSource

deMorganERad :: Expression -> ExpressionSource

The rule of De Morgan requires care with respect to the complement. The following function provides a function to manipulate with De Morgan correctly.

Functions with plugs:

tblcontents :: [A_Gen] -> [Population] -> PlugSQL -> [TblRecord]Source

Parser related stuff

parseADL1pExpr :: String -> String -> Either String (Term TermPrim)Source

Parse isolated ADL1 expression strings

data CtxError Source

Instances

createFspecSource

Arguments

:: Options

The options derived from the command line

-> IO (Guarded Fspc) 

create an Fspec, based on the user defined flags.

Type checking and calculus

data Guarded a Source

Constructors

Errors [CtxError] 
Checked a 

Generators of output

Prettyprinters

Functions with Options

Other functions

eqCl :: Eq b => (a -> b) -> [a] -> [[a]]Source

eqCl is a very useful function for gathering things that are equal wrt some criterion f. For instance, if you want to have persons with the same name: 'eqCl name persons' produces a list,in which each element is a list of persons with the same name.

unCap :: String -> StringSource

Converts the first character of a string to lowercase, with the exception that there is a second character, which is uppercase. uncap AbcDe == abcDe uncap ABcDE == ABcDE

upCap :: String -> StringSource

Converts the first character of a string to uppercase

escapeNonAlphaNum :: String -> StringSource

escape anything except regular characters and digits to _code e.g. escapeNonAlphaNum a_é = a_95_233

fatalMsg :: String -> Int -> String -> aSource

a function to create error message in a structured way, containing the version of Ampersand. It throws an error, showing a (module)name and a number. This makes debugging pretty easy.

ampersandVersionStr :: StringSource

String, containing the Ampersand version, including the build timestamp.

ampersandVersionWithoutBuildTimeStr :: StringSource

String, containing the Ampersand version

Stuff that should probably not be in the prototype

blocks2String :: PandocFormat -> Bool -> [Block] -> StringSource

write [Block] as String in a certain format using defaultWriterOptions

data Purpose Source

Explanation is the intended constructor. It explains the purpose of the object it references. The enrichment process of the parser must map the names (from PPurpose) to the actual objects

Constructors

Expl 

Fields

explPos :: Origin

The position in the Ampersand script of this purpose definition

explObj :: ExplObj

The object that is explained.

explMarkup :: A_Markup

This field contains the text of the explanation including language and markup info.

explUserdefd :: Bool

Is this purpose defined in the script?

explRefIds :: [String]

The references of the explaination