e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz{- |

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzModule : $Header$

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzDescription : CSMOF signature and sentences

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzCopyright : (c) Daniel Calegari Universidad de la Republica, Uruguay 2013

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzLicense : GPLv2 or higher, see LICENSE.txt

98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuMaintainer : dcalegar@fing.edu.uy

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzStability : provisional

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst SchulzPortability : portable

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz-}

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzmodule CSMOF.Sign where

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzimport CSMOF.As ()

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzimport qualified Common.Lib.Rel as Rel

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzimport Common.Doc

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzimport Common.DocUtils

2747c08c70e4819273caf474946ff8e31d422cd4Ewaryst Schulzimport Common.Id

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzimport qualified Data.Map as Map

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzimport qualified Data.Set as Set

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzdata TypeKind = DataTypeKind | ClassKind deriving (Show, Eq, Ord)

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzinstance Pretty TypeKind where

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz pretty DataTypeKind = text "datatype"

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz pretty ClassKind = text "class"

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzdata TypeClass = TypeClass { name :: String, kind :: TypeKind } deriving (Show, Eq, Ord)

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzinstance Pretty TypeClass where

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz pretty (TypeClass nam _) = text nam

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

2747c08c70e4819273caf474946ff8e31d422cd4Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulztype Role = String

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

2747c08c70e4819273caf474946ff8e31d422cd4Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzdata PropertyT = PropertyT { sourceRole :: Role

905f3b47b556b438c9cc283743725cbbf85b4c7eEwaryst Schulz , sourceType :: TypeClass

905f3b47b556b438c9cc283743725cbbf85b4c7eEwaryst Schulz , targetRole :: Role

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz , targetType :: TypeClass

2747c08c70e4819273caf474946ff8e31d422cd4Ewaryst Schulz } deriving (Show, Eq, Ord)

2747c08c70e4819273caf474946ff8e31d422cd4Ewaryst Schulz

2747c08c70e4819273caf474946ff8e31d422cd4Ewaryst Schulzinstance Pretty PropertyT where

2747c08c70e4819273caf474946ff8e31d422cd4Ewaryst Schulz pretty (PropertyT souR souT tarR tarT) = text "property" <> lparen <> text souR <+> colon <+> (pretty souT)

2747c08c70e4819273caf474946ff8e31d422cd4Ewaryst Schulz <+> comma <+> text tarR <+> colon <+> (pretty tarT) <> rparen

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzdata LinkT = LinkT { sourceVar :: Role

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz , targetVar :: Role

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz , property :: PropertyT

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz } deriving (Show, Eq, Ord)

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzinstance Pretty LinkT where

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz pretty (LinkT souV tarV pro) = text "link" <> lparen <> text souV <+> colon <+>

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz text (sourceRole pro) <+> colon <+> pretty (sourceType pro) <+> comma

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz <+> text tarV <+> colon <+> text (targetRole pro) <+> colon <+> (pretty (targetType pro)) <+> rparen

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulzdata Sign = Sign { types :: Set.Set TypeClass

e5cc7e9f8d96cdfe6126109bc8ab276f54c98590Ewaryst Schulz , typeRel :: Rel.Rel TypeClass

, abstractClasses :: Set.Set TypeClass

, roles :: Set.Set Role

, properties :: Set.Set PropertyT

, instances :: Map.Map String TypeClass

, links :: Set.Set LinkT

} deriving (Show, Eq, Ord)

instance GetRange Sign where

getRange _ = nullRange

rangeSpan _ = []

instance Pretty Sign where

pretty (Sign typ tyR abst rol pro ins lin) =

Set.fold (($+$) . (toType abst)) empty typ

$++$

foldr (($+$) . toSubRel) empty (Rel.toList tyR)

$++$

Set.fold (($+$) . text . ("role "++)) empty rol

$++$

Set.fold (($+$) . pretty) empty pro

$++$

foldr (($+$) . toInstance) empty (Map.toList ins)

$++$

Set.fold (($+$) . pretty) empty lin

toType :: Set.Set TypeClass -> TypeClass -> Doc

toType setTC (TypeClass nam ki) =

if Set.member (TypeClass nam ki) setTC then

text "abstract" <+> pretty ki <+> text nam

else pretty ki <+> text nam

toSubRel :: (TypeClass, TypeClass) -> Doc

toSubRel (a,b) = pretty a <+> text "<" <+> pretty b

toInstance :: (String, TypeClass) -> Doc

toInstance (a,b) = text "object" <+> text a <+> colon <+> pretty b

emptySign :: Sign

emptySign = Sign { types = Set.empty

, typeRel = Rel.empty

, abstractClasses = Set.empty

, roles = Set.empty

, properties = Set.empty

, instances = Map.empty

, links = Set.empty

}

-- signUnion :: Sign -> Sign -> Result Sign

-- signUnion s1 s2 = return s1

-- { rels = Map.unionWith Set.union (rels s1) (rels s2)

-- , isas = Rel.union (isas s1) (isas s2) }

data MultConstr = MultConstr { getType :: TypeClass

, getRole :: Role

} deriving (Show, Eq, Ord)

instance Pretty MultConstr where

pretty (MultConstr tc ro) = pretty tc <> text "." <> text ro

data ConstraintType = EQUAL | LEQ | GEQ deriving (Show, Eq, Ord)

instance Pretty ConstraintType where

pretty EQUAL = equals

pretty LEQ = text "<="

pretty GEQ = text ">="

data Sen = Sen { constraint :: MultConstr

, cardinality :: Integer

, constraintType :: ConstraintType

} deriving (Show, Eq, Ord)

instance GetRange Sen where

getRange _ = nullRange

rangeSpan _ = []

instance Pretty Sen where

pretty (Sen con car cty) = pretty con <+> pretty cty <+> pretty car