As.hs revision a30f01d9bab02e774903e515af16ee55cdaf11f2
ca010363454de207082dfaa4b753531ce2a34551Christian MaederModule : $Header$
59a2f25e7d71b91b4eda6fa4da753473ad629619Christian MaederDescription : abstract ADL syntax
49fc18b4bb1d4a8d3ec05e0cffd5f0475b289592Christian MaederCopyright : (c) Stef Joosten, Christian Maeder DFKI GmbH 2010
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuLicense : GPLv2 or higher
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : Christian.Maeder@dfki.de
ca010363454de207082dfaa4b753531ce2a34551Christian MaederStability : provisional
49fc18b4bb1d4a8d3ec05e0cffd5f0475b289592Christian MaederPortability : portable
ac142c1b088711f911018d8108a64be80b2f2a58Christian Maeder = C Token -- ^ The name of this Concept
d27877901128f04518461d25b96d2d93a13f01e4Christian Maeder | Anything -- ^ Really anything as introduced by I and V
ac142c1b088711f911018d8108a64be80b2f2a58Christian Maeder deriving (Eq, Ord, Show)
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maederinstance GetRange Concept where
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maeder getRange c = case c of
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maeder C t -> getRange t
b603f34b79bc0992e5d74f484e5bdc9f9c2346c6Christian Maeder Anything -> nullRange
53301de22afd7190981b363b57c48df86fcb50f7Christian Maeder rangeSpan c = case c of
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maeder C t -> rangeSpan t
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maeder Anything -> []
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maederdata RelType = RelType
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maeder { relSrc :: Concept -- ^ the source concept
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maeder , relTrg :: Concept -- ^ the target concept
10b02b2343246df6773585636fe3ddbefa3b6a1bChristian Maeder } deriving (Eq, Ord, Show)
ad270004874ce1d0697fb30d7309f180553bb315Christian Maederinstance GetRange RelType where
fc8c6570c7b4ee13f375eb607bed2290438573bfChristian Maeder getRange = getRange . relSrc
83cc27e4ca7cf1a4bb5f4a8df17d3e6d44e6f1eaChristian Maeder rangeSpan (RelType c1 c2) =
53301de22afd7190981b363b57c48df86fcb50f7Christian Maeder joinRanges [rangeSpan c1, rangeSpan c2]
53301de22afd7190981b363b57c48df86fcb50f7Christian Maederdata Relation = Sgn
83cc27e4ca7cf1a4bb5f4a8df17d3e6d44e6f1eaChristian Maeder { decnm :: Token -- ^ the name
59a2f25e7d71b91b4eda6fa4da753473ad629619Christian Maeder , relType :: RelType
59a2f25e7d71b91b4eda6fa4da753473ad629619Christian Maeder } deriving (Eq, Ord, Show)
59a2f25e7d71b91b4eda6fa4da753473ad629619Christian Maederinstance GetRange Relation where
fc8c6570c7b4ee13f375eb607bed2290438573bfChristian Maeder getRange = getRange . decnm
83cc27e4ca7cf1a4bb5f4a8df17d3e6d44e6f1eaChristian Maeder rangeSpan (Sgn n t) =
59a2f25e7d71b91b4eda6fa4da753473ad629619Christian Maeder joinRanges [rangeSpan n, rangeSpan t]
53301de22afd7190981b363b57c48df86fcb50f7Christian Maeder-- | builtin relation over Anything
53301de22afd7190981b363b57c48df86fcb50f7Christian MaederbRels :: [String]
49fc18b4bb1d4a8d3ec05e0cffd5f0475b289592Christian MaederbRels = ["I", "V"]
53301de22afd7190981b363b57c48df86fcb50f7Christian MaederisBRel :: String -> Bool
0a39036fa485579a7b7c81cdd44a412392571927Christian MaederisBRel s = elem s bRels
0a39036fa485579a7b7c81cdd44a412392571927Christian Maeder = K0 -- ^ Reflexive and transitive closure *
59a2f25e7d71b91b4eda6fa4da753473ad629619Christian Maeder | K1 -- ^ Transitive closure +
59a2f25e7d71b91b4eda6fa4da753473ad629619Christian Maeder | Cp -- ^ Complement -
962036a37b92afb04ac0725cde9f20e599c04c5fChristian Maeder | Co -- ^ Converse ~
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder deriving (Eq, Ord)
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maederinstance Show UnOp where
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder show o = case o of
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder Cp -> "-" -- prefix!
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder = Fc -- ^ composition ;
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder | Fd -- ^ relative addition !
59a2f25e7d71b91b4eda6fa4da753473ad629619Christian Maeder | Fi -- ^ intersection /\.
6e2c88c65d50b2e44f7afa165e6a5fac0724f08cChristian Maeder | Fu -- ^ union \/
6e2c88c65d50b2e44f7afa165e6a5fac0724f08cChristian Maeder | Ri -- ^ Rule implication |-
6e2c88c65d50b2e44f7afa165e6a5fac0724f08cChristian Maeder | Rr -- ^ Rule reverse implication -|
1eb10c0c30323eed3cc21082fd242cd09a612dc5Christian Maeder | Re -- ^ Rule equivalence
1eb10c0c30323eed3cc21082fd242cd09a612dc5Christian Maeder deriving (Eq, Ord)
1eb10c0c30323eed3cc21082fd242cd09a612dc5Christian Maederinstance Show MulOp where
c2c1ca07d7f3c2228b66599a7fb37b90fe6fb3bcChristian Maeder show o = case o of
1eb10c0c30323eed3cc21082fd242cd09a612dc5Christian Maeder = Tm Relation
6e2c88c65d50b2e44f7afa165e6a5fac0724f08cChristian Maeder | MulExp MulOp [Rule]
6e2c88c65d50b2e44f7afa165e6a5fac0724f08cChristian Maeder | UnExp UnOp Rule
d591a82b32594f0992b27477cacb00b97226c9c8Christian Maeder deriving (Eq, Ord, Show)
d591a82b32594f0992b27477cacb00b97226c9c8Christian Maederinstance GetRange Rule where
c4d4df505f3ca488978629c65f4fd15a3ba2833aChristian Maeder getRange e = case e of
6e2c88c65d50b2e44f7afa165e6a5fac0724f08cChristian Maeder Tm r -> getRange r
72b9099aeec0762bae4546db3bc4b48721027bf4Christian Maeder UnExp _ f -> getRange f
72b9099aeec0762bae4546db3bc4b48721027bf4Christian Maeder MulExp _ es -> concatMapRange getRange es
72b9099aeec0762bae4546db3bc4b48721027bf4Christian Maeder rangeSpan e = case e of
6e2c88c65d50b2e44f7afa165e6a5fac0724f08cChristian Maeder Tm r -> rangeSpan r
d591a82b32594f0992b27477cacb00b97226c9c8Christian Maeder UnExp _ f -> rangeSpan f
6fc65e097da8013f5f4f96c8b343b9b48cd3d9e1Christian Maeder MulExp _ es -> joinRanges $ map rangeSpan es
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder = Uni -- ^ univalent
6fc65e097da8013f5f4f96c8b343b9b48cd3d9e1Christian Maeder | Inj -- ^ injective
add9c81ed5250ba046a8581ff75b2284bd69e219Christian Maeder | Sur -- ^ surjective
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder | Tot -- ^ total
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder | Sym -- ^ symmetric
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder | Asy -- ^ antisymmetric
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder | Trn -- ^ transitive
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder | Rfx -- ^ reflexive
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder | Prop -- ^ meta property
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder deriving (Enum, Eq, Ord, Show)
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian MaedershowUp :: Show a => a -> String
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian MaedershowUp = map toUpper . show
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian MaederallProps :: [Prop]
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian MaederallProps = [Uni .. Rfx]
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maederdata RangedProp = RangedProp
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder { propProp :: Prop
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder , propRange :: Range }
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder deriving (Eq, Ord, Show) -- should be fine since ranges are always equal
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maederinstance GetRange RangedProp where
639732746d7c3a586790043b452a4cbdd29a3fc3Christian Maeder getRange = propRange
639732746d7c3a586790043b452a4cbdd29a3fc3Christian Maeder rangeSpan (RangedProp p r) = tokenRange (Token (show p) r)
639732746d7c3a586790043b452a4cbdd29a3fc3Christian Maeder-- | create a ranged property
639732746d7c3a586790043b452a4cbdd29a3fc3Christian MaederrProp :: Prop -> RangedProp
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian MaederrProp p = RangedProp p nullRange
adfdcfa67b7f12df6df7292e238c3f9a4b637980Christian Maederdata Object = Object
d591a82b32594f0992b27477cacb00b97226c9c8Christian Maeder { label :: Token
d591a82b32594f0992b27477cacb00b97226c9c8Christian Maeder , expr :: Rule
6e2c88c65d50b2e44f7afa165e6a5fac0724f08cChristian Maeder , props :: [RangedProp]
d591a82b32594f0992b27477cacb00b97226c9c8Christian Maeder , subobjs :: [Object]
6e2c88c65d50b2e44f7afa165e6a5fac0724f08cChristian Maeder } deriving Show
d591a82b32594f0992b27477cacb00b97226c9c8Christian Maederdata KeyAtt = KeyAtt (Maybe Token) Rule deriving Show
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maederinstance GetRange KeyAtt where
6e2c88c65d50b2e44f7afa165e6a5fac0724f08cChristian Maeder getRange (KeyAtt _ e) = getRange e
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder rangeSpan (KeyAtt _ e) = rangeSpan e
6e2c88c65d50b2e44f7afa165e6a5fac0724f08cChristian Maederdata KeyDef = KeyDef
6e2c88c65d50b2e44f7afa165e6a5fac0724f08cChristian Maeder { kdlbl :: Token
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder , kdcpt :: Concept
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder , kdats :: [KeyAtt]
7946f81bdc77b0790ac47ccaf2912a1d55c8336dChristian Maeder } deriving Show
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maederinstance GetRange KeyDef where
72b9099aeec0762bae4546db3bc4b48721027bf4Christian Maeder getRange (KeyDef _ c _) = getRange c
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder rangeSpan (KeyDef _ c as) = joinRanges [rangeSpan c, rangeSpan as]
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maederdata RuleKind = SignalOn | Signals | Maintains deriving (Eq, Ord, Show)
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian MaedershowRuleKind :: RuleKind -> String
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian MaedershowRuleKind k = if k == SignalOn then "ON"
7946f81bdc77b0790ac47ccaf2912a1d55c8336dChristian Maeder else showUp k
72b9099aeec0762bae4546db3bc4b48721027bf4Christian Maederdata RuleHeader = Always | RuleHeader RuleKind Token deriving (Eq, Show)
7946f81bdc77b0790ac47ccaf2912a1d55c8336dChristian Maederdata Pair = Pair Token Token deriving Show
72b9099aeec0762bae4546db3bc4b48721027bf4Christian Maederdata Plugin = Service | Sqlplug | Phpplug deriving Show
7946f81bdc77b0790ac47ccaf2912a1d55c8336dChristian Maeder = Pr RuleHeader Rule
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder | Pg Concept Concept -- specific and generic concept
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder | Pm [RangedProp] Relation Bool -- True indicates population
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder | Plug Plugin Object
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder | Population Bool Relation [Pair] -- True indicates declaration
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maeder deriving Show
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maederdata Context = Context (Maybe Token) [PatElem] deriving Show
4b8e74c68d62fc4e5a1739b11f8df09beaecbee8Christian Maederinstance GetRange Context where
d27877901128f04518461d25b96d2d93a13f01e4Christian Maeder getRange (Context mt _) = getRange mt