{- |
Module      :  ./CSMOF/Parser.hs
Description :  CSMOF XMI parser
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.Parser where

import CSMOF.As
import CSMOF.XMLKeywords

import Text.XML.Light
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)

parseCSMOF :: Element -> Metamodel
parseCSMOF :: Element -> Metamodel
parseCSMOF el :: Element
el =
  let keyMap :: Map String String
keyMap = Element -> Map String String
generateKeyMap Element
el
  in if Element -> Bool
checkXMLStructure Element
el
     then let m :: Metamodel
m = Metamodel :: String -> [NamedElement] -> [Model] -> Metamodel
Metamodel {
                   metamodelName :: String
metamodelName = Element -> QName -> String
parseStringAttribute Element
el QName
metamodelNameK
                 , element :: [NamedElement]
element = Element -> Metamodel -> Map String String -> [NamedElement]
parseElements Element
el Metamodel
m Map String String
keyMap
                 , model :: [Model]
model = Element -> Metamodel -> Map String String -> [Model]
parseModels Element
el Metamodel
m Map String String
keyMap } in Metamodel
m
     else String -> Metamodel
forall t. String -> t
err "Not a CSMOF XMI document"

checkXMLStructure :: Element -> Bool
checkXMLStructure :: Element -> Bool
checkXMLStructure el :: Element
el =
  case QName -> Element -> Maybe Element
findElement QName
metamodelK Element
el of
    Nothing -> Bool
False
    Just _ -> Bool
True


parseElements :: Element -> Metamodel -> Map.Map String String -> [NamedElement]
parseElements :: Element -> Metamodel -> Map String String -> [NamedElement]
parseElements el :: Element
el metamodel :: Metamodel
metamodel keyMap :: Map String String
keyMap = (Element -> [NamedElement] -> [NamedElement])
-> [NamedElement] -> [Element] -> [NamedElement]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([NamedElement] -> [NamedElement] -> [NamedElement]
forall a. [a] -> [a] -> [a]
(++) ([NamedElement] -> [NamedElement] -> [NamedElement])
-> (Element -> [NamedElement])
-> Element
-> [NamedElement]
-> [NamedElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Metamodel -> Map String String -> Element -> [NamedElement]
createElement Metamodel
metamodel Map String String
keyMap) [] (QName -> Element -> [Element]
findChildren QName
elementK Element
el)

-- Returns a list of elements, in the case of a class, the class and its properties
createElement :: Metamodel -> Map.Map String String -> Element -> [NamedElement]
createElement :: Metamodel -> Map String String -> Element -> [NamedElement]
createElement metamodel :: Metamodel
metamodel keyMap :: Map String String
keyMap eleme :: Element
eleme =
  let name :: String
name = Element -> QName -> String
parseStringAttribute Element
eleme QName
elementNameK
      typeAtt :: String
typeAtt = Element -> QName -> String
parseStringAttribute Element
eleme QName
elementTypeK
      isAbs :: Bool
isAbs = Element -> QName -> Bool
parseBoolAttribute Element
eleme QName
elementIsAbstractK
      super :: [String]
super = Element -> [String]
parseElementSuperClass Element
eleme
  in
   case String
typeAtt of
     "CSMOF:DataType" -> Metamodel -> Map String String -> String -> [NamedElement]
createDataType Metamodel
metamodel Map String String
keyMap String
name
     _ -> Metamodel
-> Map String String
-> String
-> Bool
-> [String]
-> Element
-> [NamedElement]
createClass Metamodel
metamodel Map String String
keyMap String
name Bool
isAbs [String]
super Element
eleme -- It is a class


parseElementSuperClass :: Element -> [String]
parseElementSuperClass :: Element -> [String]
parseElementSuperClass el :: Element
el =
  case QName -> [Attr] -> Maybe String
lookupAttr QName
elementSuperClassK (Element -> [Attr]
elAttribs Element
el) of
    Nothing -> []
    Just subs :: String
subs -> String -> [String]
words String
subs


createDataType :: Metamodel -> Map.Map String String -> String -> [NamedElement]
createDataType :: Metamodel -> Map String String -> String -> [NamedElement]
createDataType metamodel :: Metamodel
metamodel _ name :: String
name =
  let namedElement_X :: NamedElement
namedElement_X = NamedElement :: String -> Metamodel -> TypeOrTypedElement -> NamedElement
NamedElement { namedElementName :: String
namedElementName = String
name
                                    , namedElementOwner :: Metamodel
namedElementOwner = Metamodel
metamodel
                                    , namedElementSubClasses :: TypeOrTypedElement
namedElementSubClasses = TType :: Type -> TypeOrTypedElement
TType { getType :: Type
getType = Type
type_X }
                                    }
      type_X :: Type
type_X = Type :: NamedElement -> DataTypeOrClass -> Type
Type { typeSuper :: NamedElement
typeSuper = NamedElement
namedElement_X
                    , typeSubClasses :: DataTypeOrClass
typeSubClasses = DDataType :: Datatype -> DataTypeOrClass
DDataType {
                       getDataType :: Datatype
getDataType = Datatype :: Type -> Datatype
Datatype { classSuper :: Type
classSuper = Type
type_X } }
                    }
  -- there is only one element
  in [NamedElement
namedElement_X]


createClass :: Metamodel -> Map.Map String String -> String -> Bool ->
               [String] -> Element -> [NamedElement]
createClass :: Metamodel
-> Map String String
-> String
-> Bool
-> [String]
-> Element
-> [NamedElement]
createClass metamodel :: Metamodel
metamodel keyMap :: Map String String
keyMap name :: String
name abst :: Bool
abst subs :: [String]
subs el :: Element
el =
  let namedElement_X :: NamedElement
namedElement_X = NamedElement :: String -> Metamodel -> TypeOrTypedElement -> NamedElement
NamedElement { namedElementName :: String
namedElementName = String
name
                                    , namedElementOwner :: Metamodel
namedElementOwner = Metamodel
metamodel
                                    , namedElementSubClasses :: TypeOrTypedElement
namedElementSubClasses = TType :: Type -> TypeOrTypedElement
TType {
                                       getType :: Type
getType = Type
type_X }
                                    }
      type_X :: Type
type_X = Type :: NamedElement -> DataTypeOrClass -> Type
Type { typeSuper :: NamedElement
typeSuper = NamedElement
namedElement_X
                    , typeSubClasses :: DataTypeOrClass
typeSubClasses = DClass :: Class -> DataTypeOrClass
DClass { getClass :: Class
getClass = Class
class_X }
                    }
      class_X :: Class
class_X = Class :: Type -> Bool -> [Class] -> [Property] -> Class
Class { classSuperType :: Type
classSuperType = Type
type_X
                      , isAbstract :: Bool
isAbstract = Bool
abst
                      , superClass :: [Class]
superClass = (String -> [Class] -> [Class]) -> [Class] -> [String] -> [Class]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Class -> [Class] -> [Class])
-> (String -> Class) -> String -> [Class] -> [Class]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String String -> Metamodel -> String -> Class
linkClass Map String String
keyMap Metamodel
metamodel)
                         [] [String]
subs
                      , ownedAttribute :: [Property]
ownedAttribute = [Property]
ownedAttributes
                      }
      ownedAttributes :: [Property]
ownedAttributes = (Element -> [Property] -> [Property])
-> [Property] -> [Element] -> [Property]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Property -> [Property] -> [Property])
-> (Element -> Property) -> Element -> [Property] -> [Property]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metamodel -> Map String String -> Class -> Element -> Property
createProperty Metamodel
metamodel Map String String
keyMap Class
class_X)
       [] (QName -> Element -> [Element]
findChildren QName
ownedAttributeK Element
el)
  -- there is the class and every property inside it
  in NamedElement
namedElement_X NamedElement -> [NamedElement] -> [NamedElement]
forall a. a -> [a] -> [a]
: (Property -> NamedElement) -> [Property] -> [NamedElement]
forall a b. (a -> b) -> [a] -> [b]
map (TypedElement -> NamedElement
typedElementSuper (TypedElement -> NamedElement)
-> (Property -> TypedElement) -> Property -> NamedElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> TypedElement
propertySuper) [Property]
ownedAttributes


createProperty :: Metamodel -> Map.Map String String -> Class -> Element -> Property
createProperty :: Metamodel -> Map String String -> Class -> Element -> Property
createProperty metamodel :: Metamodel
metamodel keyMap :: Map String String
keyMap cla :: Class
cla el :: Element
el =
  let lowe :: Integer
lowe = Element -> QName -> Integer
parseIntegerAttribute Element
el QName
ownedAttributeLowerK
      uppe :: Integer
uppe = Element -> QName -> Integer
parseIntegerAttribute Element
el QName
ownedAttributeUpperK
      name :: String
name = Element -> QName -> String
parseStringAttribute Element
el QName
ownedAttributeNameK
      typeEl :: Type
typeEl = Map String String -> Metamodel -> Element -> Type
parsePropertyType Map String String
keyMap Metamodel
metamodel Element
el
      souName :: Type
souName = Type
typeEl
      tarName :: Type
tarName = Class -> Type
classSuperType Class
cla
      opp :: Maybe Property
opp = Map String String
-> Metamodel -> Element -> Type -> Type -> Maybe Property
parsePropertyOpposite Map String String
keyMap Metamodel
metamodel Element
el Type
tarName Type
souName
      namedElement :: NamedElement
namedElement = NamedElement :: String -> Metamodel -> TypeOrTypedElement -> NamedElement
NamedElement { namedElementName :: String
namedElementName = String
name
                                  , namedElementOwner :: Metamodel
namedElementOwner = Metamodel
metamodel
                                  , namedElementSubClasses :: TypeOrTypedElement
namedElementSubClasses = TTypedElement :: TypedElement -> TypeOrTypedElement
TTypedElement {
                                     getTypeElement :: TypedElement
getTypeElement = TypedElement
typedElement }
                                  }
      typedElement :: TypedElement
typedElement = TypedElement :: NamedElement -> Type -> Property -> TypedElement
TypedElement { typedElementSuper :: NamedElement
typedElementSuper = NamedElement
namedElement
                                  , typedElementType :: Type
typedElementType = Type
typeEl
                                  , typedElementSubClasses :: Property
typedElementSubClasses = Property
property
                                  }
      property :: Property
property = Property :: TypedElement
-> MultiplicityElement -> Maybe Property -> Class -> Property
Property { propertySuper :: TypedElement
propertySuper = TypedElement
typedElement
                          , multiplicityElement :: MultiplicityElement
multiplicityElement = MultiplicityElement :: Integer -> Integer -> Property -> MultiplicityElement
MultiplicityElement {
                                      lower :: Integer
lower = Integer
lowe
                                    , upper :: Integer
upper = Integer
uppe
                                    , multiplicityElementSubClasses :: Property
multiplicityElementSubClasses = Property
property }
                                    , opposite :: Maybe Property
opposite = Maybe Property
opp
                                   , propertyClass :: Class
propertyClass = Class
cla } in Property
property

parsePropertyType :: Map.Map String String -> Metamodel -> Element -> Type
parsePropertyType :: Map String String -> Metamodel -> Element -> Type
parsePropertyType keyMap :: Map String String
keyMap metamodel :: Metamodel
metamodel el :: Element
el =
  case QName -> [Attr] -> Maybe String
lookupAttr QName
ownedAttributeTypeK (Element -> [Attr]
elAttribs Element
el) of
    Nothing -> String -> Type
forall t. String -> t
err "Property type does not exists"
    Just typ :: String
typ -> Map String String -> Metamodel -> String -> Type
linkTypeElem Map String String
keyMap Metamodel
metamodel String
typ


parsePropertyOpposite :: Map.Map String String -> Metamodel -> Element ->
                         Type -> Type -> Maybe Property
parsePropertyOpposite :: Map String String
-> Metamodel -> Element -> Type -> Type -> Maybe Property
parsePropertyOpposite keyMap :: Map String String
keyMap metamodel :: Metamodel
metamodel el :: Element
el souTyp :: Type
souTyp tarTyp :: Type
tarTyp =
  case QName -> [Attr] -> Maybe String
lookupAttr QName
ownedAttributeOppositeK (Element -> [Attr]
elAttribs Element
el) of
    Nothing -> Maybe Property
forall a. Maybe a
Nothing
    Just opp :: String
opp -> Property -> Maybe Property
forall a. a -> Maybe a
Just (Map String String
-> Metamodel -> String -> Type -> Type -> Property
linkProperty Map String String
keyMap Metamodel
metamodel String
opp Type
tarTyp Type
souTyp)


-- ------ Model Part

parseModels :: Element -> Metamodel -> Map.Map String String -> [Model]
parseModels :: Element -> Metamodel -> Map String String -> [Model]
parseModels el :: Element
el metamodel :: Metamodel
metamodel keyMap :: Map String String
keyMap = (Element -> [Model] -> [Model]) -> [Model] -> [Element] -> [Model]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Model -> [Model] -> [Model])
-> (Element -> Model) -> Element -> [Model] -> [Model]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metamodel -> Map String String -> Element -> Model
createModel Metamodel
metamodel Map String String
keyMap)
 [] (QName -> Element -> [Element]
findChildren QName
modelK Element
el)


createModel :: Metamodel -> Map.Map String String -> Element -> Model
createModel :: Metamodel -> Map String String -> Element -> Model
createModel metamodel :: Metamodel
metamodel keyMap :: Map String String
keyMap el :: Element
el =
  let mode :: Model
mode = Model :: String -> [Object] -> [Link] -> Metamodel -> Model
Model { modelName :: String
modelName = Element -> QName -> String
parseStringAttribute Element
el QName
modelNameK
                   , object :: [Object]
object = Metamodel -> Model -> Map String String -> Element -> [Object]
parseObjects Metamodel
metamodel Model
mode Map String String
keyMap Element
el
                   , link :: [Link]
link = Metamodel -> Model -> Map String String -> Element -> [Link]
parseLinks Metamodel
metamodel Model
mode Map String String
keyMap Element
el
                   , modelType :: Metamodel
modelType = Metamodel
metamodel
                   }
  in Model
mode


parseObjects :: Metamodel -> Model -> Map.Map String String -> Element -> [Object]
parseObjects :: Metamodel -> Model -> Map String String -> Element -> [Object]
parseObjects metamodel :: Metamodel
metamodel mode :: Model
mode keyMap :: Map String String
keyMap el :: Element
el = (Element -> [Object] -> [Object])
-> [Object] -> [Element] -> [Object]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Object -> [Object] -> [Object])
-> (Element -> Object) -> Element -> [Object] -> [Object]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   Metamodel -> Model -> Map String String -> Element -> Object
createObject Metamodel
metamodel Model
mode Map String String
keyMap) [] (QName -> Element -> [Element]
findChildren QName
objectK Element
el)

createObject :: Metamodel -> Model -> Map.Map String String -> Element -> Object
createObject :: Metamodel -> Model -> Map String String -> Element -> Object
createObject metamodel :: Metamodel
metamodel mode :: Model
mode keyMap :: Map String String
keyMap eleme :: Element
eleme =
  let name :: String
name = Element -> QName -> String
parseStringAttribute Element
eleme QName
objectNameK
      typeAtt :: String
typeAtt = Element -> QName -> String
parseStringAttribute Element
eleme QName
objectTypeK
  in Object :: String -> Type -> Model -> Object
Object { objectName :: String
objectName = String
name
            , objectType :: Type
objectType = Map String String -> Metamodel -> String -> Type
linkTypeElem Map String String
keyMap Metamodel
metamodel String
typeAtt
            , objectOwner :: Model
objectOwner = Model
mode
            }


parseLinks :: Metamodel -> Model -> Map.Map String String -> Element -> [Link]
parseLinks :: Metamodel -> Model -> Map String String -> Element -> [Link]
parseLinks metamodel :: Metamodel
metamodel mode :: Model
mode keyMap :: Map String String
keyMap el :: Element
el = (Element -> [Link] -> [Link]) -> [Link] -> [Element] -> [Link]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (Link -> [Link] -> [Link])
-> (Element -> Link) -> Element -> [Link] -> [Link]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
 Metamodel -> Model -> Map String String -> Element -> Link
createLink Metamodel
metamodel Model
mode Map String String
keyMap) [] (QName -> Element -> [Element]
findChildren QName
linkK Element
el)

createLink :: Metamodel -> Model -> Map.Map String String -> Element -> Link
createLink :: Metamodel -> Model -> Map String String -> Element -> Link
createLink metamodel :: Metamodel
metamodel mode :: Model
mode keyMap :: Map String String
keyMap eleme :: Element
eleme =
  let typ :: String
typ = Element -> QName -> String
parseStringAttribute Element
eleme QName
linkTypeK
      sour :: String
sour = Element -> QName -> String
parseStringAttribute Element
eleme QName
linkSourceK
      targ :: String
targ = Element -> QName -> String
parseStringAttribute Element
eleme QName
linkTargetK
      sourObj :: Object
sourObj = Map String String -> Metamodel -> String -> Object
linkObject Map String String
keyMap Metamodel
metamodel String
sour
      tarObj :: Object
tarObj = Map String String -> Metamodel -> String -> Object
linkObject Map String String
keyMap Metamodel
metamodel String
targ
      souObjTyp :: Type
souObjTyp = Object -> Type
objectType Object
sourObj
      tarObjTyp :: Type
tarObjTyp = Object -> Type
objectType Object
tarObj
  in Link :: Property -> Object -> Object -> Model -> Link
Link { linkType :: Property
linkType = Map String String
-> Metamodel -> String -> Type -> Type -> Property
linkProperty Map String String
keyMap Metamodel
metamodel String
typ Type
souObjTyp Type
tarObjTyp
          , source :: Object
source = Object
sourObj
          , target :: Object
target = Object
tarObj
          , linkOwner :: Model
linkOwner = Model
mode
          }


parseStringAttribute :: Element -> QName -> String
parseStringAttribute :: Element -> QName -> String
parseStringAttribute el :: Element
el key :: QName
key = String -> Maybe String -> String
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe
  (String -> String
forall t. String -> t
err ("Attribute does not exists: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ QName -> String
forall a. Show a => a -> String
show QName
key))
  (QName -> [Attr] -> Maybe String
lookupAttr QName
key (Element -> [Attr]
elAttribs Element
el))

parseIntegerAttribute :: Element -> QName -> Integer
parseIntegerAttribute :: Element -> QName -> Integer
parseIntegerAttribute el :: Element
el key :: QName
key =
  case QName -> [Attr] -> Maybe String
lookupAttr QName
key (Element -> [Attr]
elAttribs Element
el) of
    Nothing -> 1
    Just low :: String
low -> String -> Integer
forall a. Read a => String -> a
read String
low :: Integer

parseBoolAttribute :: Element -> QName -> Bool
parseBoolAttribute :: Element -> QName -> Bool
parseBoolAttribute el :: Element
el key :: QName
key =
  case QName -> [Attr] -> Maybe String
lookupAttr QName
key (Element -> [Attr]
elAttribs Element
el) of
    Nothing -> Bool
False
    Just abst :: String
abst -> case String
abst of
                  "true" -> Bool
True
                  _ -> Bool
False


-- --- Functions for linking elements searching on of them using it key

linkClass :: Map.Map String String -> Metamodel -> String -> Class
linkClass :: Map String String -> Metamodel -> String -> Class
linkClass keyMap :: Map String String
keyMap metamodel :: Metamodel
metamodel key :: String
key =
  let name :: String
name = String -> Map String String -> String
findElementInMap String
key Map String String
keyMap
      list :: [Class]
list = (NamedElement -> Class) -> [NamedElement] -> [Class]
forall a b. (a -> b) -> [a] -> [b]
map NamedElement -> Class
toClass ((NamedElement -> Bool) -> [NamedElement] -> [NamedElement]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> NamedElement -> Bool
equalClassName String
name) (Metamodel -> [NamedElement]
element Metamodel
metamodel))
  in
   case [Class]
list of
     [] -> String -> Class
forall t. String -> t
err ("Class not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
     h :: Class
h : _ -> Class
h


linkObject :: Map.Map String String -> Metamodel -> String -> Object
linkObject :: Map String String -> Metamodel -> String -> Object
linkObject keyMap :: Map String String
keyMap metamodel :: Metamodel
metamodel key :: String
key =
  let name :: String
name = String -> Map String String -> String
findElementInMap String
key Map String String
keyMap
      list :: [Object]
list = (Object -> Bool) -> [Object] -> [Object]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Object -> Bool
equalObjectName String
name) (Model -> [Object]
object (Map String String -> Metamodel -> String -> Model
rightModel Map String String
keyMap Metamodel
metamodel String
key))
  in
   case [Object]
list of
     [] -> String -> Object
forall t. String -> t
err ("Object not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
     h :: Object
h : _ -> Object
h


linkTypeElem :: Map.Map String String -> Metamodel -> String -> Type
linkTypeElem :: Map String String -> Metamodel -> String -> Type
linkTypeElem keyMap :: Map String String
keyMap metamodel :: Metamodel
metamodel key :: String
key =
  let name :: String
name = String -> Map String String -> String
findElementInMap String
key Map String String
keyMap
      list :: [Type]
list = (NamedElement -> Type) -> [NamedElement] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map NamedElement -> Type
toType ((NamedElement -> Bool) -> [NamedElement] -> [NamedElement]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> NamedElement -> Bool
equalTypeName String
name) (Metamodel -> [NamedElement]
element Metamodel
metamodel))
  in
   case [Type]
list of
     [] -> String -> Type
forall t. String -> t
err ("Type not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
     h :: Type
h : _ -> Type
h


linkProperty :: Map.Map String String -> Metamodel -> String -> Type -> Type -> Property
linkProperty :: Map String String
-> Metamodel -> String -> Type -> Type -> Property
linkProperty keyMap :: Map String String
keyMap metamodel :: Metamodel
metamodel key :: String
key souTyp :: Type
souTyp tarTyp :: Type
tarTyp =
  let prop :: String
prop = String -> Map String String -> String
findElementInMap String
key Map String String
keyMap
      list :: [Property]
list = (NamedElement -> Property) -> [NamedElement] -> [Property]
forall a b. (a -> b) -> [a] -> [b]
map NamedElement -> Property
toProperty ((NamedElement -> Bool) -> [NamedElement] -> [NamedElement]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Type -> Type -> NamedElement -> Bool
sameProperty String
prop Type
souTyp Type
tarTyp) (Metamodel -> [NamedElement]
element Metamodel
metamodel))
  in
   case [Property]
list of
     [] -> String -> Property
forall t. String -> t
err ("Property not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prop String -> String -> String
forall a. [a] -> [a] -> [a]
++ " - " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ " - " String -> String -> String
forall a. [a] -> [a] -> [a]
++
             NamedElement -> String
namedElementName (Type -> NamedElement
typeSuper Type
souTyp) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " - " String -> String -> String
forall a. [a] -> [a] -> [a]
++
             NamedElement -> String
namedElementName (Type -> NamedElement
typeSuper Type
tarTyp))
     h :: Property
h : _ -> Property
h


equalClassName :: String -> NamedElement -> Bool
equalClassName :: String -> NamedElement -> Bool
equalClassName name :: String
name ne :: NamedElement
ne =
  case NamedElement
ne of
    (NamedElement _ _ (TType (Type _ (DClass _)))) -> NamedElement -> String
namedElementName NamedElement
ne String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name
    _ -> Bool
False

toClass :: NamedElement -> Class
toClass :: NamedElement -> Class
toClass ne :: NamedElement
ne =
  case NamedElement
ne of
    (NamedElement _ _ (TType (Type _ (DClass cl :: Class
cl)))) -> Class
cl
    _ -> String -> Class
forall t. String -> t
err ("Wrong cast: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NamedElement -> String
namedElementName NamedElement
ne)


equalObjectName :: String -> Object -> Bool
equalObjectName :: String -> Object -> Bool
equalObjectName name :: String
name ob :: Object
ob = Object -> String
objectName Object
ob String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name


equalTypeName :: String -> NamedElement -> Bool
equalTypeName :: String -> NamedElement -> Bool
equalTypeName name :: String
name ne :: NamedElement
ne =
  case NamedElement
ne of
    (NamedElement _ _ (TType _)) -> NamedElement -> String
namedElementName NamedElement
ne String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name
    _ -> Bool
False

toType :: NamedElement -> Type
toType :: NamedElement -> Type
toType ne :: NamedElement
ne =
  case NamedElement
ne of
    (NamedElement _ _ (TType ty :: Type
ty)) -> Type
ty
    _ -> String -> Type
forall t. String -> t
err ("Wrong cast: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NamedElement -> String
namedElementName NamedElement
ne)


sameProperty :: String -> Type -> Type -> NamedElement -> Bool
sameProperty :: String -> Type -> Type -> NamedElement -> Bool
sameProperty name :: String
name souTyp2 :: Type
souTyp2 tarTyp2 :: Type
tarTyp2 ne :: NamedElement
ne =
  case NamedElement
ne of
    (NamedElement _ _ (TTypedElement (TypedElement _ tarCl :: Type
tarCl prop :: Property
prop))) ->
      let tarTyp :: String
tarTyp = NamedElement -> String
namedElementName (Type -> NamedElement
typeSuper Type
tarCl)
          souTyp :: String
souTyp = NamedElement -> String
namedElementName (Type -> NamedElement
typeSuper (Class -> Type
classSuperType (Property -> Class
propertyClass Property
prop)))
          lisSouTyp2 :: [String]
lisSouTyp2 = Type -> [String]
getSuperTypesNames Type
souTyp2
          lisTarTyp2 :: [String]
lisTarTyp2 = Type -> [String]
getSuperTypesNames Type
tarTyp2
      in (NamedElement -> String
namedElementName NamedElement
ne String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name) Bool -> Bool -> Bool
&&
         String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
souTyp [String]
lisSouTyp2 Bool -> Bool -> Bool
&&
         (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
tarTyp Bool -> Bool -> Bool
|| String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
tarTyp [String]
lisTarTyp2)
    _ -> Bool
False


getSuperTypesNames :: Type -> [String]
getSuperTypesNames :: Type -> [String]
getSuperTypesNames typ :: Type
typ =
  case Type
typ of
    (Type _ (DClass (Class _ _ superClasses :: [Class]
superClasses _ ))) ->
      let super :: [String]
super = (Class -> [String] -> [String]) -> [String] -> [Class] -> [String]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) ([String] -> [String] -> [String])
-> (Class -> [String]) -> Class -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> [String]
getSuperTypesNames (Type -> [String]) -> (Class -> Type) -> Class -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Type
classSuperType) []
                   [Class]
superClasses
      in NamedElement -> String
namedElementName (Type -> NamedElement
typeSuper Type
typ) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
super
    (Type _ (DDataType (Datatype dt :: Type
dt))) -> [NamedElement -> String
namedElementName (Type -> NamedElement
typeSuper Type
dt)]


equalPropertyName :: String -> NamedElement -> Bool
equalPropertyName :: String -> NamedElement -> Bool
equalPropertyName name :: String
name ne :: NamedElement
ne =
  case NamedElement
ne of
    (NamedElement _ _ (TTypedElement (TypedElement {}))) ->
     NamedElement -> String
namedElementName NamedElement
ne String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
name
    _ -> Bool
False

toProperty :: NamedElement -> Property
toProperty :: NamedElement -> Property
toProperty ne :: NamedElement
ne =
  case NamedElement
ne of
    (NamedElement _ _ (TTypedElement (TypedElement _ _ pro :: Property
pro))) -> Property
pro
    _ -> String -> Property
forall t. String -> t
err ("Wrong cast: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NamedElement -> String
namedElementName NamedElement
ne)


-- Search for the right model according to the key
rightModel :: Map.Map String String -> Metamodel -> String -> Model
rightModel :: Map String String -> Metamodel -> String -> Model
rightModel keyMap :: Map String String
keyMap metamodel :: Metamodel
metamodel key :: String
key = [Model] -> Model
forall a. [a] -> a
head ((Model -> Bool) -> [Model] -> [Model]
forall a. (a -> Bool) -> [a] -> [a]
filter (Map String String -> String -> Model -> Bool
isModel Map String String
keyMap String
key) (Metamodel -> [Model]
model Metamodel
metamodel))

isModel :: Map.Map String String -> String -> Model -> Bool
isModel :: Map String String -> String -> Model -> Bool
isModel keyMap :: Map String String
keyMap key :: String
key mode :: Model
mode =
  let el :: String
el = String -> Map String String -> String
findElementInMap (String -> String
getModelKey String
key) Map String String
keyMap
  in Model -> String
modelName Model
mode String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
el

getModelKey :: String -> String
getModelKey :: String -> String
getModelKey = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '/') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse


findElementInMap :: String -> Map.Map String String -> String
findElementInMap :: String -> Map String String -> String
findElementInMap key :: String
key keyMap :: Map String String
keyMap =
  let elNam :: Maybe String
elNam = String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
key Map String String
keyMap
  in String -> Maybe String -> String
forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe (String -> String
forall t. String -> t
err ("Key not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
key)) Maybe String
elNam

-- --- Generates a Key Map for processing references between elements

generateKeyMap :: Element -> Map.Map String String
generateKeyMap :: Element -> Map String String
generateKeyMap el :: Element
el =
  let modelMap :: Map String String
modelMap = (Integer, Map String String) -> Map String String
forall a b. (a, b) -> b
snd ((Element
 -> (Integer, Map String String) -> (Integer, Map String String))
-> (Integer, Map String String)
-> [Element]
-> (Integer, Map String String)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Element
-> (Integer, Map String String) -> (Integer, Map String String)
createModelKey (0, Map String String
forall k a. Map k a
Map.empty) ([Element] -> [Element]
forall a. [a] -> [a]
reverse (QName -> Element -> [Element]
findChildren QName
modelK Element
el)))
  in (Integer, Map String String) -> Map String String
forall a b. (a, b) -> b
snd ((Element
 -> (Integer, Map String String) -> (Integer, Map String String))
-> (Integer, Map String String)
-> [Element]
-> (Integer, Map String String)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Element
-> (Integer, Map String String) -> (Integer, Map String String)
createElementKey (0, Map String String
modelMap) ([Element] -> [Element]
forall a. [a] -> [a]
reverse (QName -> Element -> [Element]
findChildren QName
elementK Element
el)))


createElementKey :: Element -> (Integer, Map.Map String String) ->
                    (Integer, Map.Map String String)
createElementKey :: Element
-> (Integer, Map String String) -> (Integer, Map String String)
createElementKey eleme :: Element
eleme (pos :: Integer
pos, mapp :: Map String String
mapp) =
  let key :: String
key = "//@element." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
pos
      mapElements :: Map String String
mapElements = String -> String -> Map String String -> Map String String
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
key (Element -> QName -> String
parseStringAttribute Element
eleme QName
elementNameK) Map String String
mapp
  in (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1, (String, Integer, Map String String) -> Map String String
third ((Element
 -> (String, Integer, Map String String)
 -> (String, Integer, Map String String))
-> (String, Integer, Map String String)
-> [Element]
-> (String, Integer, Map String String)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Element
-> (String, Integer, Map String String)
-> (String, Integer, Map String String)
createChildrenKeys (String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/@ownedAttribute.", 0,
      Map String String
mapElements) ([Element] -> [Element]
forall a. [a] -> [a]
reverse (QName -> Element -> [Element]
findChildren QName
ownedAttributeK Element
eleme))))


createModelKey :: Element -> (Integer, Map.Map String String) -> (Integer, Map.Map String String)
createModelKey :: Element
-> (Integer, Map String String) -> (Integer, Map String String)
createModelKey eleme :: Element
eleme (pos :: Integer
pos, mapp :: Map String String
mapp) =
  let key :: String
key = "//@model." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
pos
      mapModel :: Map String String
mapModel = String -> String -> Map String String -> Map String String
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/") (Element -> QName -> String
parseStringAttribute Element
eleme QName
modelNameK) Map String String
mapp
  in (Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1, (String, Integer, Map String String) -> Map String String
third ((Element
 -> (String, Integer, Map String String)
 -> (String, Integer, Map String String))
-> (String, Integer, Map String String)
-> [Element]
-> (String, Integer, Map String String)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Element
-> (String, Integer, Map String String)
-> (String, Integer, Map String String)
createChildrenKeys (String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/@object.", 0, Map String String
mapModel)
     ([Element] -> [Element]
forall a. [a] -> [a]
reverse (QName -> Element -> [Element]
findChildren QName
objectK Element
eleme))))


createChildrenKeys :: Element -> (String, Integer, Map.Map String String) ->
                      (String, Integer, Map.Map String String)
createChildrenKeys :: Element
-> (String, Integer, Map String String)
-> (String, Integer, Map String String)
createChildrenKeys eleme :: Element
eleme (keySup :: String
keySup, pos :: Integer
pos, mapp :: Map String String
mapp) =
  let key :: String
key = String
keySup String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
pos
  in (String
keySup, Integer
pos Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ 1, String -> String -> Map String String -> Map String String
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
key (Element -> QName -> String
parseStringAttribute Element
eleme QName
objectNameK) Map String String
mapp)


third :: (String, Integer, Map.Map String String) -> Map.Map String String
third :: (String, Integer, Map String String) -> Map String String
third (_, _, c :: Map String String
c) = Map String String
c


-- --- Auxiliary Functions

-- | error messages for the parser
err :: String -> t
err :: String -> t
err s :: String
s = String -> t
forall a. HasCallStack => String -> a
error (String -> t) -> String -> t
forall a b. (a -> b) -> a -> b
$ "XML parser: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s