module CM.Metamodel where
import Data.Maybe
import CM.Validity
type Identifier = String
class (Show i) => Identifiable i where
identifier :: i -> Identifier
identifier = show
identic :: i -> i -> Bool
identic x y = identifier x == identifier y
class (Show e, Read e) => CMElement e where
simpleConstraints :: [e -> Validity]
simpleConstraints = []
complexConstaints :: (ConceptualModel m) => [m -> e -> Validity]
complexConstaints = []
constraints :: (ConceptualModel m) => m -> [e -> Validity]
constraints model = simpleConstraints ++ map (\f -> f model) complexConstaints
evalConstraints :: (ConceptualModel m) => m -> e -> [Validity]
evalConstraints model x = map ($ x) $ constraints model
valid :: (ConceptualModel m) => m -> e -> Bool
valid model x = all isValid (evalConstraints model x)
violations :: (ConceptualModel m) => m -> e -> [String]
violations model x = mapMaybe violationMessage $ evalConstraints model x
elementName :: e -> String
elementName = takeWhile (/= ' ') . show
toMeta :: (ConceptualModel m) => m -> e -> MetaElement
fromMeta :: e -> MetaElement -> Maybe e
fromMeta _ _ = Nothing
class (CMElement a) => ConceptualModel a where
cmodelElements :: a -> [MetaElement]
validModel :: a -> Bool
validModel m = validSelf && validElements
where validSelf = valid m m
validElements = all metaElementValid (cmodelElements m)
cmodelName :: a -> String
cmodelName = elementName
toMetaModel :: (ConceptualModel b) => b -> a -> MetaElement
toMetaModel _ m = MetaModel { mmName = Just $ cmodelName m
, mmElements = cmodelElements m
, mmIdentifier = Nothing
, mmValid = validModel m
}
class (CMElement a, Identifiable a) => Entity a where
entityAttributes :: a -> [MetaAttribute]
entityName :: a -> String
entityName = elementName
entitySuperNames :: a -> [String]
entitySuperNames _ = []
entitySubNames :: a -> [String]
entitySubNames _ = []
toMetaEntity :: (ConceptualModel m) => m -> a -> MetaElement
toMetaEntity m x = MetaEntity { meName = entityName x
, meAttributes = entityAttributes x
, meIdentifier = identifier x
, meValid = valid m x
, meSuperNames = entitySuperNames x
, meSubNames = entitySubNames x
}
class (CMElement a, Identifiable a) => Relationship a where
relationshipParticipations :: a -> [MetaParticipation]
relationshipName :: a -> String
relationshipName = elementName
toMetaRelationship :: (ConceptualModel m) => m -> a -> MetaElement
toMetaRelationship m x = MetaRelationship { mrName = relationshipName x
, mrParticipations = relationshipParticipations x
, mrIdentifier = identifier x
, mrValid = valid m x
}
data ParticipationQuantity
= Limited Word
| Unlimited
| Unique
deriving (Show, Read, Eq, Ord)
data ParticipationType
= Mandatory ParticipationQuantity
| Optional ParticipationQuantity
| Custom ParticipationQuantity ParticipationQuantity
deriving (Show, Read, Eq)
data MetaAttribute = MetaAttribute { maName :: String
, maType :: String
, maValue :: String
} deriving (Show, Read, Eq)
data MetaParticipation = MetaParticipation { mpName :: String
, mpType :: String
, mpIdentifier :: String
, mpPType :: ParticipationType
} deriving (Show, Read, Eq)
data MetaElement
= MetaEntity { meName :: String
, meIdentifier :: String
, meAttributes :: [MetaAttribute]
, meValid :: Bool
, meSuperNames :: [String]
, meSubNames :: [String]
}
| MetaRelationship { mrName :: String
, mrIdentifier :: String
, mrParticipations :: [MetaParticipation]
, mrValid :: Bool
}
| MetaModel { mmName :: Maybe String
, mmIdentifier :: Maybe String
, mmElements :: [MetaElement]
, mmValid :: Bool
}
deriving (Show, Read, Eq)
metaElementName :: MetaElement -> String
metaElementName MetaEntity {..} = meName
metaElementName MetaRelationship {..} = mrName
metaElementName MetaModel {..} = fromMaybe "" mmName
metaElementIdentifier :: MetaElement -> String
metaElementIdentifier MetaEntity {..} = meIdentifier
metaElementIdentifier MetaRelationship {..} = mrIdentifier
metaElementIdentifier MetaModel {..} = fromMaybe "" mmIdentifier
metaElementValid :: MetaElement -> Bool
metaElementValid MetaEntity {..} = meValid
metaElementValid MetaRelationship {..} = mrValid
metaElementValid MetaModel {..} = mmValid
tupleToAttribute :: (String, String, String) -> MetaAttribute
tupleToAttribute (a, b, c) = MetaAttribute {maName = a, maType = b, maValue = c}
tupleToParticipation :: (String, String, String, ParticipationType) -> MetaParticipation
tupleToParticipation (a, b, c, t) = MetaParticipation {mpName = a, mpType = b, mpIdentifier = c, mpPType = t}
instance CMElement MetaElement where
toMeta _ = id
elementName MetaEntity {..} = meName
elementName MetaRelationship {..} = mrName
elementName MetaModel {..} = fromMaybe "" mmName
instance Identifiable MetaElement where
identifier MetaEntity {..} = meIdentifier
identifier MetaRelationship {..} = mrIdentifier
identifier MetaModel {..} = fromMaybe "" mmIdentifier
instance Entity MetaElement where
entityAttributes MetaEntity {..} =
map tupleToAttribute
[ ("name", "String", meName)
, ("attributes", "[MetaAttribute]", show meAttributes)
]
entityAttributes MetaRelationship {..} =
map tupleToAttribute
[ ("name", "String", mrName)
, ("participants", "[MetaParticipation]", show mrParticipations)
]
entityAttributes MetaModel {..} =
map tupleToAttribute
[ ("name", "String", fromMaybe "" mmName)
, ("elements", "[MetaElement]", show mmElements)
]