| 7c808aadfb7293563388dbe16d84cf3384bb5d3c |
|
25-Jul-2013 |
Daniel Calegari <dcalegar@fing.edu.uy> |
{- |
Module : $Header$
Description : abstract CSMOF syntax
Copyright : (c) Daniel Calegari Universidad de la Republica, Uruguay 2013
License : GPLv2 or higher, see LICENSE.txt
Maintainer : dcalegar@fing.edu.uy
Stability : provisional
Portability : portable
-}
module CSMOF.As where
import qualified Data.Set as Set
-- Simplified MOF Metamodel
data Metamodel = Metamodel
{ metamodelName :: String
<dl><dt> , element
</dt><dd>Set.Set NamedElement
</dd><dt> , model
</dt><dd>Set.Set Model
} deriving (Eq, Ord)
instance Show Metamodel where
show (Metamodel nam ele mod) =
"Metamodel { name = " ++ nam ++ "\n"
++ Set.fold ((++). show) "" ele
++ Set.fold ((++). show) "" mod
++ "} \n"
data NamedElement = NamedElement
{ namedElementName :: String
</dd><dt> , namedElementOwner
</dt><dd>Metamodel
</dd><dt> , namedElementSubClasses
</dt><dd>TypeOrTypedElement
} deriving (Eq, Ord)
instance Show NamedElement where
show (NamedElement nam met nes) = show nes
data TypeOrTypedElement = TType { getType :: Type }
| TTypedElement { getTypeElement :: TypedElement }
deriving (Eq, Ord)
instance Show TypeOrTypedElement where
show (TType typ) = show typ
show (TTypedElement typ) = show typ
data Type = Type { typeSuper :: NamedElement
</dd><dt> , typeSubClasses
</dt><dd>DataTypeOrClass
} deriving (Eq, Ord)
instance Show Type where
show (Type sup sub) = show sub
data DataTypeOrClass = DataType
| DClass { getClass :: Class }
deriving (Eq, Ord)
instance Show DataTypeOrClass where
show (DataType) = show "DataType"
show (DClass cla) = show cla
data Class = Class
{ classSuper :: Type
</dd><dt> , isAbstract
</dt><dd>Bool
</dd><dt> , superClass
</dt><dd>Set.Set Class
</dd><dt> , ownedAttribute
</dt><dd>Set.Set Property
} deriving (Eq, Ord)
instance Show Class where
show (Class sup isa supC own) =
"\t\t Class { name = " ++ namedElementName (typeSuper sup) ++ " , "
++ "abstract = " ++ show isa
++ ", super = { " ++ Set.fold ((++). namedElementName . typeSuper . classSuper) "" supC ++ "}"
</dd><dt> -- TODO
</dt><dd>faltan los ownedAttribute
++ "} \n"
data TypedElement = TypedElement
{ typedElementSuper :: NamedElement
</dd><dt> , typedElementType
</dt><dd>Type
</dd><dt> , typedElementSubClasses
</dt><dd>Property
} deriving (Eq, Ord)
instance Show TypedElement where
show (TypedElement sup typ sub) = show sub
data Property = Property
{ propertySuper ::TypedElement
</dd><dt> , multiplicityElement
</dt><dd>MultiplicityElement
</dd><dt> , opposite
</dt><dd>Maybe Property
</dd><dt> , propertyClass
</dt><dd>Class
} deriving (Eq, Ord)
instance Show Property where
show (Property sup mul opp pro) =
"Property { name = " ++ namedElementName (typedElementSuper sup) ++ ", "
++ show mul ++ ", "
++ case opp of
Just n -> "opposite = " ++ namedElementName (typedElementSuper (propertySuper n)) ++ ","
Nothing -> "opposite = EMPTY, "
++ "owner = " ++ namedElementName (typeSuper (classSuper pro))
++ "} \n"
data MultiplicityElement = MultiplicityElement
{ lower :: Integer
</dd><dt> , upper
</dt><dd>Integer
</dd><dt> , multiplicityElementSubClasses
</dt><dd>Property
} deriving (Eq, Ord)
instance Show MultiplicityElement where
show (MultiplicityElement low upp mes) =
"lower = " ++ show low ++ ", upper = " ++ show upp
-- Model part of CSMOF
data Model = Model
{ modelName :: String
</dd><dt> , object
</dt><dd>Set.Set Object
</dd><dt> , link
</dt><dd>Set.Set Link
</dd><dt> , modelType
</dt><dd>Metamodel
} deriving (Eq, Ord)
instance Show Model where
show (Model mon obj lin mod) =
"Model { name = " ++ mon ++ "\n"
++ Set.fold ((++). show) "" obj
++ Set.fold ((++). show) "" lin
++ "} \n"
data Object = Object
{ objectName :: String
</dd><dt> , objectType
</dt><dd>Type
</dd><dt> , objectOwner
</dt><dd>Model
} deriving (Eq, Ord)
instance Show Object where
show (Object on ot oo) =
"\t Object { name = " ++ on
++ ", type = " ++ namedElementName (typeSuper ot)
++ " } \n"
data Link = Link
{ linkType :: Property
</dd><dt> , source
</dt><dd>Object
</dd><dt> , target
</dt><dd>Object
</dd><dt> , linkOwner
</dt><dd>Model
} deriving (Eq, Ord)
instance Show Link where
show (Link lt sou tar ow) =
"\t Link { type = " ++ namedElementName (typedElementSuper (propertySuper lt)) ++ ", "
++ "source = " ++ objectName sou ++ ", "
++ "target = " ++ objectName tar
++ "} \n"
<hr />
--main :: IO ()
--main = let metamodel = Metamodel{metamodelName = "Class"
-- , element = Set.insert neUMLME (Set.insert neString Set.empty)
-- , model = Set.empty}
--
-- neString = NamedElement { namedElementName = "String"
-- , typeOrTypedElem = TType { getTypeType = DataType }
-- , namedElementOwner = metamodel
-- }
-- neUMLME = NamedElement { namedElementName = "UMLModelElement"
-- , typeOrTypedElem = TType { getTypeType =
-- TClass { getClass =
-- Class { isAbstract = True
-- , superClass = Set.empty
-- , ownedAttribute = Set.empty
-- }
-- }
-- }
-- , namedElementOwner = metamodel
-- }
-- in
-- putStrLn (show metamodel)
-- <element xsi:type="CSMOF:Class" name="UMLModelElement" isAbstract="true" subClass="_@element.1 _@element.2 _@element.3">
-- <ownedAttribute name="kind" type="_@element.6"/>
-- <ownedAttribute name="name" type="_@element.6"/>
-- </element>
-- <element xsi:type="CSMOF:Class" name="Package" superClass="_@element.0">
-- <ownedAttribute lower="0" upper="-1" name="elements" type="_@element.2" opposite="_@element.2/@ownedAttribute.0"/>
-- </element>
-- <element xsi:type="CSMOF:Class" name="Classifier" superClass="_@element.0" subClass="_@element.4 _@element.5">
-- <ownedAttribute name="namespace" type="_@element.1" opposite="_@element.1/@ownedAttribute.0"/>
-- </element>
-- <element xsi:type="CSMOF:Class" name="Attribute" superClass="_@element.0">
-- <ownedAttribute name="owner" type="_@element.4" opposite="_@element.4/@ownedAttribute.0"/>
-- <ownedAttribute name="type" type="_@element.5"/>
-- </element>
-- <element xsi:type="CSMOF:Class" name="Class" superClass="_@element.2">
-- <ownedAttribute lower="0" upper="-1" name="attribute" type="_@element.3" opposite="_@element.3/@ownedAttribute.0"/>
-- </element>
-- <element xsi:type="CSMOF:Class" name="PrimitiveDataType" superClass="_@element.2"/>
git-svn-id: https://svn-agbkb.informatik.uni-bremen.de/Hets/trunk@18059 cec4b9c1-7d33-0410-9eda-942365e851bb |