{- |
Module      :  ./QVTR/StatAna.hs
Description :  Static QVTR analysis
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 QVTR.StatAna where

import QVTR.As
import QVTR.Sign

import qualified CSMOF.As as CSMOFAs
import qualified CSMOF.Sign as CSMOFSign
import qualified CSMOF.StatAna as CSMOFStatAna

import Common.Result
import Common.GlobalAnnotations
import Common.ExtSign
import Common.AS_Annotation

import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Common.Lib.Rel as Rel

basicAna :: (Transformation, Sign, GlobalAnnos) ->
            Result (Transformation, ExtSign Sign (), [Named Sen])
basicAna :: (Transformation, Sign, GlobalAnnos)
-> Result (Transformation, ExtSign Sign (), [Named Sen])
basicAna (trans :: Transformation
trans, _, _) =
  let
    (sign :: Sign
sign, diagSign :: [Diagnosis]
diagSign) = Transformation -> (Sign, [Diagnosis])
buildSignature Transformation
trans
    (sen :: [Named Sen]
sen, diagSen :: [Diagnosis]
diagSen) = Sign -> Transformation -> ([Named Sen], [Diagnosis])
buildSentences Sign
sign Transformation
trans
  in [Diagnosis]
-> Maybe (Transformation, ExtSign Sign (), [Named Sen])
-> Result (Transformation, ExtSign Sign (), [Named Sen])
forall a. [Diagnosis] -> Maybe a -> Result a
Result ([Diagnosis] -> [Diagnosis]
forall a. [a] -> [a]
reverse [Diagnosis]
diagSign [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a]
reverse [Diagnosis]
diagSen)
            (Maybe (Transformation, ExtSign Sign (), [Named Sen])
 -> Result (Transformation, ExtSign Sign (), [Named Sen]))
-> Maybe (Transformation, ExtSign Sign (), [Named Sen])
-> Result (Transformation, ExtSign Sign (), [Named Sen])
forall a b. (a -> b) -> a -> b
$ (Transformation, ExtSign Sign (), [Named Sen])
-> Maybe (Transformation, ExtSign Sign (), [Named Sen])
forall a. a -> Maybe a
Just (Transformation
trans, Sign -> ExtSign Sign ()
forall sign symbol. sign -> ExtSign sign symbol
mkExtSign Sign
sign, [Named Sen]
sen)


buildSignature :: Transformation -> (Sign, [Diagnosis])
buildSignature :: Transformation -> (Sign, [Diagnosis])
buildSignature (Transformation _ souMet :: (String, String, Metamodel)
souMet tarMet :: (String, String, Metamodel)
tarMet kS :: [Key]
kS rels :: [Relation]
rels) =
  let
    souMetSign :: Sign
souMetSign = Metamodel -> Sign
CSMOFStatAna.buildSignature ((String, String, Metamodel) -> Metamodel
third (String, String, Metamodel)
souMet)
    tarMetSign :: Sign
tarMetSign = Metamodel -> Sign
CSMOFStatAna.buildSignature ((String, String, Metamodel) -> Metamodel
third (String, String, Metamodel)
tarMet)
    (relat :: (Map String RuleDef, Map String RuleDef)
relat, diagn :: [Diagnosis]
diagn) = Sign
-> Sign
-> [Relation]
-> ((Map String RuleDef, Map String RuleDef), [Diagnosis])
buildRelations Sign
souMetSign Sign
tarMetSign [Relation]
rels
    (keyD :: [(String, String)]
keyD, diagn2 :: [Diagnosis]
diagn2) = Sign -> Sign -> [Key] -> ([(String, String)], [Diagnosis])
buildKeyDefs Sign
souMetSign Sign
tarMetSign [Key]
kS
  in
    (Sign :: Sign
-> Sign
-> Map String RuleDef
-> Map String RuleDef
-> [(String, String)]
-> Sign
Sign { sourceSign :: Sign
sourceSign = Sign
souMetSign
          , targetSign :: Sign
targetSign = Sign
tarMetSign
          , nonTopRelations :: Map String RuleDef
nonTopRelations = (Map String RuleDef, Map String RuleDef) -> Map String RuleDef
forall a b. (a, b) -> a
fst (Map String RuleDef, Map String RuleDef)
relat
          , topRelations :: Map String RuleDef
topRelations = (Map String RuleDef, Map String RuleDef) -> Map String RuleDef
forall a b. (a, b) -> b
snd (Map String RuleDef, Map String RuleDef)
relat
          , keyDefs :: [(String, String)]
keyDefs = [(String, String)]
keyD
          }
     , [Diagnosis]
diagn [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diagn2)


buildRelations :: CSMOFSign.Sign -> CSMOFSign.Sign -> [Relation] ->
                  ((Map.Map String RuleDef, Map.Map String RuleDef), [Diagnosis])
buildRelations :: Sign
-> Sign
-> [Relation]
-> ((Map String RuleDef, Map String RuleDef), [Diagnosis])
buildRelations souMetSign :: Sign
souMetSign tarMetSign :: Sign
tarMetSign rels :: [Relation]
rels =
  let
    (nonTopRel :: [Relation]
nonTopRel, topRel :: [Relation]
topRel) = [Relation] -> ([Relation], [Relation])
separateTopFromNonTop [Relation]
rels
    calledTopRules :: [Relation]
calledTopRules = (Relation -> Relation) -> [Relation] -> [Relation]
forall a b. (a -> b) -> [a] -> [b]
map Relation -> Relation
createCalledTopRule [Relation]
topRel
    (nonTopRuleDef :: Map String RuleDef
nonTopRuleDef, diagn1 :: [Diagnosis]
diagn1) = (Relation
 -> (Map String RuleDef, [Diagnosis])
 -> (Map String RuleDef, [Diagnosis]))
-> (Map String RuleDef, [Diagnosis])
-> [Relation]
-> (Map String RuleDef, [Diagnosis])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Sign
-> Sign
-> Relation
-> (Map String RuleDef, [Diagnosis])
-> (Map String RuleDef, [Diagnosis])
createRuleDef Sign
souMetSign Sign
tarMetSign)
                                    (Map String RuleDef
forall k a. Map k a
Map.empty, []) ([Relation]
nonTopRel [Relation] -> [Relation] -> [Relation]
forall a. [a] -> [a] -> [a]
++ [Relation]
calledTopRules)
    (topRuleDef :: Map String RuleDef
topRuleDef, diagn2 :: [Diagnosis]
diagn2) = (Relation
 -> (Map String RuleDef, [Diagnosis])
 -> (Map String RuleDef, [Diagnosis]))
-> (Map String RuleDef, [Diagnosis])
-> [Relation]
-> (Map String RuleDef, [Diagnosis])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Sign
-> Sign
-> Relation
-> (Map String RuleDef, [Diagnosis])
-> (Map String RuleDef, [Diagnosis])
createRuleDef Sign
souMetSign Sign
tarMetSign)
                                 (Map String RuleDef
forall k a. Map k a
Map.empty, []) [Relation]
topRel
  in
    ((Map String RuleDef
nonTopRuleDef, Map String RuleDef
topRuleDef), [Diagnosis]
diagn1 [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diagn2)


separateTopFromNonTop :: [Relation] -> ([Relation], [Relation])
separateTopFromNonTop :: [Relation] -> ([Relation], [Relation])
separateTopFromNonTop rels :: [Relation]
rels =
  case [Relation]
rels of
    [] -> ([], [])
    r :: Relation
r : rest :: [Relation]
rest -> let result :: ([Relation], [Relation])
result = [Relation] -> ([Relation], [Relation])
separateTopFromNonTop [Relation]
rest
                in
                  if Relation -> Bool
isTop Relation
r then
                    (([Relation], [Relation]) -> [Relation]
forall a b. (a, b) -> a
fst ([Relation], [Relation])
result, Relation
r Relation -> [Relation] -> [Relation]
forall a. a -> [a] -> [a]
: ([Relation], [Relation]) -> [Relation]
forall a b. (a, b) -> b
snd ([Relation], [Relation])
result)
                  else (Relation
r Relation -> [Relation] -> [Relation]
forall a. a -> [a] -> [a]
: ([Relation], [Relation]) -> [Relation]
forall a b. (a, b) -> a
fst ([Relation], [Relation])
result, ([Relation], [Relation]) -> [Relation]
forall a b. (a, b) -> b
snd ([Relation], [Relation])
result)


isTop :: Relation -> Bool
isTop :: Relation -> Bool
isTop (Relation tp :: Bool
tp _ _ _ _ _ _ _) = Bool
tp


createRuleDef :: CSMOFSign.Sign -> CSMOFSign.Sign -> Relation ->
                   (Map.Map String RuleDef, [Diagnosis]) ->
                   (Map.Map String RuleDef, [Diagnosis])
createRuleDef :: Sign
-> Sign
-> Relation
-> (Map String RuleDef, [Diagnosis])
-> (Map String RuleDef, [Diagnosis])
createRuleDef souMetSign :: Sign
souMetSign tarMetSign :: Sign
tarMetSign (Relation tp :: Bool
tp rName :: String
rName _ prD :: [PrimitiveDomain]
prD souD :: Domain
souD tarD :: Domain
tarD _ _)
                                    (mapRD :: Map String RuleDef
mapRD, diag :: [Diagnosis]
diag) =
  let (varTyp :: [TypeClass]
varTyp, diag2 :: [Diagnosis]
diag2) = Sign
-> Sign
-> [PrimitiveDomain]
-> Domain
-> Domain
-> ([TypeClass], [Diagnosis])
getTypesFromVars Sign
souMetSign Sign
tarMetSign [PrimitiveDomain]
prD Domain
souD Domain
tarD
  in
    if Bool
tp
    then case String -> Map String RuleDef -> Maybe RuleDef
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ("Top_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rName) Map String RuleDef
mapRD of
           Nothing -> (String -> RuleDef -> Map String RuleDef -> Map String RuleDef
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ("Top_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rName)
                      (String -> Bool -> [TypeClass] -> RuleDef
RuleDef ("Top_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rName) Bool
tp []) Map String RuleDef
mapRD, [Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2)
           Just r :: RuleDef
r -> (Map String RuleDef
mapRD, DiagKind -> String -> String -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "rule names must be unique"
                              (RuleDef -> String
QVTR.Sign.name RuleDef
r) Diagnosis -> [Diagnosis] -> [Diagnosis]
forall a. a -> [a] -> [a]
: ([Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2))
    else case String -> Map String RuleDef -> Maybe RuleDef
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
rName Map String RuleDef
mapRD of
           Nothing -> (String -> RuleDef -> Map String RuleDef -> Map String RuleDef
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
rName (String -> Bool -> [TypeClass] -> RuleDef
RuleDef String
rName Bool
tp [TypeClass]
varTyp) Map String RuleDef
mapRD,
                       [Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2)
           Just r :: RuleDef
r -> (Map String RuleDef
mapRD, DiagKind -> String -> String -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "rule names must be unique"
                              (RuleDef -> String
QVTR.Sign.name RuleDef
r) Diagnosis -> [Diagnosis] -> [Diagnosis]
forall a. a -> [a] -> [a]
: ([Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2))


-- Generate rule parameters from primitive domains, source and target object domains
getTypesFromVars :: CSMOFSign.Sign -> CSMOFSign.Sign -> [PrimitiveDomain] ->
                    Domain -> Domain -> ([CSMOFSign.TypeClass], [Diagnosis])
getTypesFromVars :: Sign
-> Sign
-> [PrimitiveDomain]
-> Domain
-> Domain
-> ([TypeClass], [Diagnosis])
getTypesFromVars souMetSign :: Sign
souMetSign tarMetSign :: Sign
tarMetSign primD :: [PrimitiveDomain]
primD souD :: Domain
souD tarD :: Domain
tarD =
  let
    (souDomObj :: Maybe TypeClass
souDomObj, d1 :: [Diagnosis]
d1) = Sign -> Domain -> (Maybe TypeClass, [Diagnosis])
getDomainType Sign
souMetSign Domain
souD
    (tarDomObj :: Maybe TypeClass
tarDomObj, d2 :: [Diagnosis]
d2) = Sign -> Domain -> (Maybe TypeClass, [Diagnosis])
getDomainType Sign
tarMetSign Domain
tarD
    (pTypes :: [Maybe TypeClass]
pTypes, d3 :: [[Diagnosis]]
d3) = [(Maybe TypeClass, [Diagnosis])]
-> ([Maybe TypeClass], [[Diagnosis]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Maybe TypeClass, [Diagnosis])]
 -> ([Maybe TypeClass], [[Diagnosis]]))
-> [(Maybe TypeClass, [Diagnosis])]
-> ([Maybe TypeClass], [[Diagnosis]])
forall a b. (a -> b) -> a -> b
$ (PrimitiveDomain -> (Maybe TypeClass, [Diagnosis]))
-> [PrimitiveDomain] -> [(Maybe TypeClass, [Diagnosis])]
forall a b. (a -> b) -> [a] -> [b]
map (Sign -> Sign -> PrimitiveDomain -> (Maybe TypeClass, [Diagnosis])
getPrimitiveDomainType Sign
souMetSign Sign
tarMetSign) [PrimitiveDomain]
primD
    primTypes :: [TypeClass]
primTypes = [Maybe TypeClass] -> [TypeClass]
forall a. [Maybe a] -> [a]
getSomething [Maybe TypeClass]
pTypes
  in
    case Maybe TypeClass
souDomObj of
      Nothing -> case Maybe TypeClass
tarDomObj of
                   Nothing -> ([TypeClass]
primTypes, [Diagnosis]
d1 [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
d2 [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [[Diagnosis]] -> [Diagnosis]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Diagnosis]]
d3)
                   Just tDO :: TypeClass
tDO -> (TypeClass
tDO TypeClass -> [TypeClass] -> [TypeClass]
forall a. a -> [a] -> [a]
: [TypeClass]
primTypes, [[Diagnosis]] -> [Diagnosis]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Diagnosis]]
d3)
      Just sDO :: TypeClass
sDO -> case Maybe TypeClass
tarDomObj of
                   Nothing -> (TypeClass
sDO TypeClass -> [TypeClass] -> [TypeClass]
forall a. a -> [a] -> [a]
: [TypeClass]
primTypes, [Diagnosis]
d1 [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
d2 [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [[Diagnosis]] -> [Diagnosis]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Diagnosis]]
d3)
                   Just tDO :: TypeClass
tDO -> (TypeClass
sDO TypeClass -> [TypeClass] -> [TypeClass]
forall a. a -> [a] -> [a]
: (TypeClass
tDO TypeClass -> [TypeClass] -> [TypeClass]
forall a. a -> [a] -> [a]
: [TypeClass]
primTypes), [[Diagnosis]] -> [Diagnosis]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Diagnosis]]
d3)


getDomainType :: CSMOFSign.Sign -> Domain -> (Maybe CSMOFSign.TypeClass, [Diagnosis])
getDomainType :: Sign -> Domain -> (Maybe TypeClass, [Diagnosis])
getDomainType metSign :: Sign
metSign (Domain _ (ObjectTemplate _ _ dType :: String
dType _)) =
  [TypeClass] -> String -> (Maybe TypeClass, [Diagnosis])
getType (Set TypeClass -> [TypeClass]
forall a. Set a -> [a]
Set.toList (Sign -> Set TypeClass
CSMOFSign.types Sign
metSign)) String
dType


getPrimitiveDomainType :: CSMOFSign.Sign -> CSMOFSign.Sign -> PrimitiveDomain ->
                          (Maybe CSMOFSign.TypeClass, [Diagnosis])
getPrimitiveDomainType :: Sign -> Sign -> PrimitiveDomain -> (Maybe TypeClass, [Diagnosis])
getPrimitiveDomainType souMetSign :: Sign
souMetSign tarMetSign :: Sign
tarMetSign (PrimitiveDomain _ prType :: String
prType) =
  let (typ :: Maybe TypeClass
typ, diag :: [Diagnosis]
diag) = [TypeClass] -> String -> (Maybe TypeClass, [Diagnosis])
getType (Set TypeClass -> [TypeClass]
forall a. Set a -> [a]
Set.toList (Sign -> Set TypeClass
CSMOFSign.types Sign
souMetSign)) String
prType
  in
    case Maybe TypeClass
typ of
      Nothing -> let (typ2 :: Maybe TypeClass
typ2, diag2 :: [Diagnosis]
diag2) =
                      [TypeClass] -> String -> (Maybe TypeClass, [Diagnosis])
getType (Set TypeClass -> [TypeClass]
forall a. Set a -> [a]
Set.toList (Sign -> Set TypeClass
CSMOFSign.types Sign
tarMetSign)) String
prType
                 in
                   case Maybe TypeClass
typ2 of
                     Nothing -> (Maybe TypeClass
typ2, [Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2)
                     Just _ -> (Maybe TypeClass
typ2, [])
      Just _ -> (Maybe TypeClass
typ, [])


getType :: [CSMOFSign.TypeClass] -> String -> (Maybe CSMOFSign.TypeClass, [Diagnosis])
getType :: [TypeClass] -> String -> (Maybe TypeClass, [Diagnosis])
getType types :: [TypeClass]
types dType :: String
dType =
  case [TypeClass]
types of
    [] -> (Maybe TypeClass
forall a. Maybe a
Nothing, [DiagKind -> String -> String -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "type not found" String
dType])
    typ :: TypeClass
typ : rest :: [TypeClass]
rest -> if TypeClass -> String
CSMOFSign.name TypeClass
typ String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
dType then (TypeClass -> Maybe TypeClass
forall a. a -> Maybe a
Just TypeClass
typ, [])
                  else [TypeClass] -> String -> (Maybe TypeClass, [Diagnosis])
getType [TypeClass]
rest String
dType


getSomething :: [Maybe a] -> [a]
getSomething :: [Maybe a] -> [a]
getSomething list :: [Maybe a]
list =
  case [Maybe a]
list of
    [] -> []
    el :: Maybe a
el : rest :: [Maybe a]
rest -> case Maybe a
el of
                   Nothing -> [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
getSomething [Maybe a]
rest
                   Just typ :: a
typ -> a
typ a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
getSomething [Maybe a]
rest


-- Creates a non-top version of a top rule in order to generate a parametrized version of itself
createCalledTopRule :: Relation -> Relation
createCalledTopRule :: Relation -> Relation
createCalledTopRule (Relation tp :: Bool
tp a :: String
a b :: [RelVar]
b c :: [PrimitiveDomain]
c d :: Domain
d e :: Domain
e f :: Maybe WhenWhere
f g :: Maybe WhenWhere
g) = Bool
-> String
-> [RelVar]
-> [PrimitiveDomain]
-> Domain
-> Domain
-> Maybe WhenWhere
-> Maybe WhenWhere
-> Relation
Relation (Bool -> Bool
not Bool
tp) String
a [RelVar]
b [PrimitiveDomain]
c Domain
d Domain
e Maybe WhenWhere
f Maybe WhenWhere
g


buildKeyDefs :: CSMOFSign.Sign -> CSMOFSign.Sign -> [Key] -> ([(String, String)], [Diagnosis])
buildKeyDefs :: Sign -> Sign -> [Key] -> ([(String, String)], [Diagnosis])
buildKeyDefs _ _ [] = ([], [])
buildKeyDefs souMet :: Sign
souMet tarMet :: Sign
tarMet (k :: Key
k : rest :: [Key]
rest) =
  let (restK :: [(String, String)]
restK, diag :: [Diagnosis]
diag) = Sign -> Sign -> [Key] -> ([(String, String)], [Diagnosis])
buildKeyDefs Sign
souMet Sign
tarMet [Key]
rest
      (ke :: Maybe (String, String)
ke, diag2 :: [Diagnosis]
diag2) = Sign -> Sign -> Key -> (Maybe (String, String), [Diagnosis])
buildKeyDef Sign
souMet Sign
tarMet Key
k
  in
    case Maybe (String, String)
ke of
      Nothing -> ([(String, String)]
restK, [Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2)
      Just el :: (String, String)
el -> ((String, String)
el (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
restK, [Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2)


buildKeyDef :: CSMOFSign.Sign -> CSMOFSign.Sign -> Key ->
               (Maybe (String, String), [Diagnosis])
buildKeyDef :: Sign -> Sign -> Key -> (Maybe (String, String), [Diagnosis])
buildKeyDef souMet :: Sign
souMet tarMet :: Sign
tarMet k :: Key
k =
  let (typ :: Maybe TypeClass
typ, diag :: [Diagnosis]
diag) = [TypeClass] -> String -> (Maybe TypeClass, [Diagnosis])
getType (Set TypeClass -> [TypeClass]
forall a. Set a -> [a]
Set.toList (Sign -> Set TypeClass
CSMOFSign.types Sign
souMet)) (Key -> String
typeName Key
k)
  in
    case Maybe TypeClass
typ of
      Nothing -> let (typ2 :: Maybe TypeClass
typ2, diag2 :: [Diagnosis]
diag2) = [TypeClass] -> String -> (Maybe TypeClass, [Diagnosis])
getType (Set TypeClass -> [TypeClass]
forall a. Set a -> [a]
Set.toList (Sign -> Set TypeClass
CSMOFSign.types Sign
tarMet))
                                      (Key -> String
typeName Key
k)
                 in
                   case Maybe TypeClass
typ2 of
                     Nothing ->
                      (Maybe (String, String)
forall a. Maybe a
Nothing, DiagKind -> String -> String -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "type not found" (Key -> String
typeName Key
k) Diagnosis -> [Diagnosis] -> [Diagnosis]
forall a. a -> [a] -> [a]
:
                                 ([Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2))
                     Just _ -> if Sign -> String -> [PropKey] -> Bool
propKeysCheckOK Sign
tarMet (Key -> String
typeName Key
k)
                                  (Key -> [PropKey]
properties Key
k)
                               then ((String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (Key -> String
metamodel Key
k, Key -> String
typeName Key
k), [])
                               else (Maybe (String, String)
forall a. Maybe a
Nothing, DiagKind -> String -> [PropKey] -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "property not found"
                                     (Key -> [PropKey]
properties Key
k) Diagnosis -> [Diagnosis] -> [Diagnosis]
forall a. a -> [a] -> [a]
: ([Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2))
      Just _ -> if Sign -> String -> [PropKey] -> Bool
propKeysCheckOK Sign
souMet (Key -> String
typeName Key
k) (Key -> [PropKey]
properties Key
k) then
                  ((String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (Key -> String
metamodel Key
k, Key -> String
typeName Key
k), [])
                else (Maybe (String, String)
forall a. Maybe a
Nothing, DiagKind -> String -> [PropKey] -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "property not found"
                                (Key -> [PropKey]
properties Key
k) Diagnosis -> [Diagnosis] -> [Diagnosis]
forall a. a -> [a] -> [a]
: [Diagnosis]
diag)


-- ------ Sentences --------

buildSentences :: Sign -> Transformation -> ([Named Sen], [Diagnosis])
buildSentences :: Sign -> Transformation -> ([Named Sen], [Diagnosis])
buildSentences sign :: Sign
sign (Transformation _ souMet :: (String, String, Metamodel)
souMet tarMet :: (String, String, Metamodel)
tarMet kes :: [Key]
kes rels :: [Relation]
rels) =
  let
    (_, sMetN :: String
sMetN, _) = (String, String, Metamodel)
souMet
    (_, tMetN :: String
tMetN, _) = (String, String, Metamodel)
tarMet
    (keyConstr :: [Named Sen]
keyConstr, diag :: [Diagnosis]
diag) = Sign -> String -> String -> [Key] -> ([Named Sen], [Diagnosis])
buildKeyConstr Sign
sign String
sMetN String
tMetN [Key]
kes
    (qvtRules :: [Named Sen]
qvtRules, diag2 :: [Diagnosis]
diag2) = Sign
-> (String, String, Metamodel)
-> (String, String, Metamodel)
-> [Relation]
-> ([Named Sen], [Diagnosis])
buildRules Sign
sign (String, String, Metamodel)
souMet (String, String, Metamodel)
tarMet [Relation]
rels
  in
    ([Named Sen]
keyConstr [Named Sen] -> [Named Sen] -> [Named Sen]
forall a. [a] -> [a] -> [a]
++ [Named Sen]
qvtRules, [Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2)


buildKeyConstr :: Sign -> String -> String -> [Key] -> ([Named Sen], [Diagnosis])
buildKeyConstr :: Sign -> String -> String -> [Key] -> ([Named Sen], [Diagnosis])
buildKeyConstr _ _ _ [] = ([], [])
buildKeyConstr sign :: Sign
sign sMetN :: String
sMetN tMetN :: String
tMetN (k :: Key
k : rest :: [Key]
rest) =
  let
    (restK :: [Named Sen]
restK, diag :: [Diagnosis]
diag) = Sign -> String -> String -> [Key] -> ([Named Sen], [Diagnosis])
buildKeyConstr Sign
sign String
sMetN String
tMetN [Key]
rest
    (ke :: Maybe (Named Sen)
ke, diag2 :: [Diagnosis]
diag2) = Sign -> String -> String -> Key -> (Maybe (Named Sen), [Diagnosis])
buildKeyC Sign
sign String
sMetN String
tMetN Key
k
  in
    case Maybe (Named Sen)
ke of
      Nothing -> ([Named Sen]
restK, [Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2)
      Just el :: Named Sen
el -> (Named Sen
el Named Sen -> [Named Sen] -> [Named Sen]
forall a. a -> [a] -> [a]
: [Named Sen]
restK, [Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2)


buildKeyC :: Sign -> String -> String -> Key -> (Maybe (Named Sen), [Diagnosis])
buildKeyC :: Sign -> String -> String -> Key -> (Maybe (Named Sen), [Diagnosis])
buildKeyC sign :: Sign
sign sMetN :: String
sMetN tMetN :: String
tMetN k :: Key
k =
  if String
sMetN String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Key -> String
metamodel Key
k Bool -> Bool -> Bool
|| String
tMetN String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Key -> String
metamodel Key
k then
    let (typ :: Maybe TypeClass
typ, diag :: [Diagnosis]
diag) = [TypeClass] -> String -> (Maybe TypeClass, [Diagnosis])
getType
          (Set TypeClass -> [TypeClass]
forall a. Set a -> [a]
Set.toList (Sign -> Set TypeClass
CSMOFSign.types (Sign -> Sign
sourceSign Sign
sign))) (Key -> String
typeName Key
k)
    in
      case Maybe TypeClass
typ of
        Nothing -> let (typ2 :: Maybe TypeClass
typ2, diag2 :: [Diagnosis]
diag2) = [TypeClass] -> String -> (Maybe TypeClass, [Diagnosis])
getType (Set TypeClass -> [TypeClass]
forall a. Set a -> [a]
Set.toList (Sign -> Set TypeClass
CSMOFSign.types
                                        (Sign -> Sign
targetSign Sign
sign))) (Key -> String
typeName Key
k)
                   in
                     case Maybe TypeClass
typ2 of
                       Nothing -> (Maybe (Named Sen)
forall a. Maybe a
Nothing, DiagKind -> String -> String -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "type not found"
                                   (Key -> String
typeName Key
k) Diagnosis -> [Diagnosis] -> [Diagnosis]
forall a. a -> [a] -> [a]
: ([Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2))
                       Just _ ->
                        if Sign -> String -> [PropKey] -> Bool
propKeysCheckOK (Sign -> Sign
targetSign Sign
sign)
                              (Key -> String
typeName Key
k) (Key -> [PropKey]
properties Key
k)
                        then (Named Sen -> Maybe (Named Sen)
forall a. a -> Maybe a
Just (String -> Sen -> Named Sen
forall a s. a -> s -> SenAttr s a
makeNamed "" KeyConstr :: Key -> Sen
KeyConstr { keyConst :: Key
keyConst = Key
k }), [])
                        else (Maybe (Named Sen)
forall a. Maybe a
Nothing, DiagKind -> String -> [PropKey] -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "property not found"
                                        (Key -> [PropKey]
properties Key
k) Diagnosis -> [Diagnosis] -> [Diagnosis]
forall a. a -> [a] -> [a]
: ([Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diag2))
        Just _ -> if Sign -> String -> [PropKey] -> Bool
propKeysCheckOK (Sign -> Sign
sourceSign Sign
sign) (Key -> String
typeName Key
k) (Key -> [PropKey]
properties Key
k) then
                    (Named Sen -> Maybe (Named Sen)
forall a. a -> Maybe a
Just (String -> Sen -> Named Sen
forall a s. a -> s -> SenAttr s a
makeNamed "" KeyConstr :: Key -> Sen
KeyConstr { keyConst :: Key
keyConst = Key
k }), [])
                  else (Maybe (Named Sen)
forall a. Maybe a
Nothing, DiagKind -> String -> [PropKey] -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "property not found" (Key -> [PropKey]
properties Key
k) Diagnosis -> [Diagnosis] -> [Diagnosis]
forall a. a -> [a] -> [a]
: [Diagnosis]
diag)
  else (Maybe (Named Sen)
forall a. Maybe a
Nothing, [DiagKind -> String -> String -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "metamodel does not exist" (String
sMetN String -> String -> String
forall a. [a] -> [a] -> [a]
++ "-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tMetN)])


propKeysCheckOK :: CSMOFSign.Sign -> String -> [PropKey] -> Bool
propKeysCheckOK :: Sign -> String -> [PropKey] -> Bool
propKeysCheckOK _ _ [] = Bool
True
propKeysCheckOK metSign :: Sign
metSign kType :: String
kType (ke :: PropKey
ke : rest :: [PropKey]
rest) = Sign -> String -> PropKey -> Bool
propKeyCheckOK Sign
metSign String
kType PropKey
ke Bool -> Bool -> Bool
&&
 Sign -> String -> [PropKey] -> Bool
propKeysCheckOK Sign
metSign String
kType [PropKey]
rest

propKeyCheckOK :: CSMOFSign.Sign -> String -> PropKey -> Bool
propKeyCheckOK :: Sign -> String -> PropKey -> Bool
propKeyCheckOK (CSMOFSign.Sign _ typRel :: Rel TypeClass
typRel _ _ props :: Set PropertyT
props _ _) kType :: String
kType (SimpleProp pN :: String
pN) =
  Rel TypeClass -> Set PropertyT -> String -> String -> Bool
findProperty Rel TypeClass
typRel Set PropertyT
props String
kType String
pN
propKeyCheckOK (CSMOFSign.Sign _ typRel :: Rel TypeClass
typRel _ _ props :: Set PropertyT
props _ _) kType :: String
kType
               (OppositeProp oppPType :: String
oppPType oppPName :: String
oppPName) =
  Rel TypeClass
-> Set PropertyT -> String -> String -> String -> Bool
findOppProperty Rel TypeClass
typRel Set PropertyT
props String
kType String
oppPType String
oppPName


findProperty :: Rel.Rel CSMOFSign.TypeClass -> Set.Set CSMOFSign.PropertyT ->
                String -> String -> Bool
findProperty :: Rel TypeClass -> Set PropertyT -> String -> String -> Bool
findProperty typRel :: Rel TypeClass
typRel props :: Set PropertyT
props kType :: String
kType pN :: String
pN =
  let classes :: [String]
classes = String
kType String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Set String -> [String]
forall a. Set a -> [a]
Set.toList (Rel String -> String -> Set String
superClasses
                          ((TypeClass -> String) -> Rel TypeClass -> Rel String
forall a b. (Ord a, Ord b) => (a -> b) -> Rel a -> Rel b
Rel.map TypeClass -> String
CSMOFSign.name Rel TypeClass
typRel) String
kType)
  in [PropertyT] -> [String] -> String -> Bool
findPropertyByTypeAndRole (Set PropertyT -> [PropertyT]
forall a. Set a -> [a]
Set.toList Set PropertyT
props) [String]
classes String
pN


findPropertyByTypeAndRole :: [CSMOFSign.PropertyT] -> [String] -> String -> Bool
findPropertyByTypeAndRole :: [PropertyT] -> [String] -> String -> Bool
findPropertyByTypeAndRole [] _ _ = Bool
False
findPropertyByTypeAndRole (p :: PropertyT
p : rest :: [PropertyT]
rest) classes :: [String]
classes pN :: String
pN =
 (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (TypeClass -> String
CSMOFSign.name (PropertyT -> TypeClass
CSMOFSign.sourceType PropertyT
p)) [String]
classes Bool -> Bool -> Bool
&&
  PropertyT -> String
CSMOFSign.targetRole PropertyT
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pN) Bool -> Bool -> Bool
||
 (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (TypeClass -> String
CSMOFSign.name (PropertyT -> TypeClass
CSMOFSign.targetType PropertyT
p)) [String]
classes Bool -> Bool -> Bool
&&
  PropertyT -> String
CSMOFSign.sourceRole PropertyT
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pN) Bool -> Bool -> Bool
||
 [PropertyT] -> [String] -> String -> Bool
findPropertyByTypeAndRole [PropertyT]
rest [String]
classes String
pN


superClasses :: Rel.Rel String -> String -> Set.Set String
superClasses :: Rel String -> String -> Set String
superClasses relT :: Rel String
relT tc :: String
tc = (String -> Set String -> Set String)
-> Set String -> Set String -> Set String
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold String -> Set String -> Set String
reach Set String
forall a. Set a
Set.empty (Set String -> Set String) -> Set String -> Set String
forall a b. (a -> b) -> a -> b
$ Rel String -> String -> Set String
forall a. Ord a => Rel a -> a -> Set a
Rel.succs Rel String
relT String
tc where
         reach :: String -> Set String -> Set String
reach e :: String
e s :: Set String
s = if String -> Set String -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member String
e Set String
s then Set String
s
                     else (String -> Set String -> Set String)
-> Set String -> Set String -> Set String
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.fold String -> Set String -> Set String
reach (String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
Set.insert String
e Set String
s) (Set String -> Set String) -> Set String -> Set String
forall a b. (a -> b) -> a -> b
$ Rel String -> String -> Set String
forall a. Ord a => Rel a -> a -> Set a
Rel.succs Rel String
relT String
e


findPropertyInHierarchy :: Rel.Rel CSMOFSign.TypeClass ->
                           Set.Set CSMOFSign.PropertyT ->
                           String -> String -> Maybe CSMOFSign.PropertyT
findPropertyInHierarchy :: Rel TypeClass
-> Set PropertyT -> String -> String -> Maybe PropertyT
findPropertyInHierarchy typRel :: Rel TypeClass
typRel props :: Set PropertyT
props kType :: String
kType pN :: String
pN =
  let classes :: [String]
classes = String
kType String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Set String -> [String]
forall a. Set a -> [a]
Set.toList (Rel String -> String -> Set String
superClasses ((TypeClass -> String) -> Rel TypeClass -> Rel String
forall a b. (Ord a, Ord b) => (a -> b) -> Rel a -> Rel b
Rel.map TypeClass -> String
CSMOFSign.name Rel TypeClass
typRel) String
kType)
  in [PropertyT] -> [String] -> String -> Maybe PropertyT
findPropertyElemByTypeAndRole (Set PropertyT -> [PropertyT]
forall a. Set a -> [a]
Set.toList Set PropertyT
props) [String]
classes String
pN


findPropertyElemByTypeAndRole :: [CSMOFSign.PropertyT] -> [String] -> String ->
                                 Maybe CSMOFSign.PropertyT
findPropertyElemByTypeAndRole :: [PropertyT] -> [String] -> String -> Maybe PropertyT
findPropertyElemByTypeAndRole [] _ _ = Maybe PropertyT
forall a. Maybe a
Nothing
findPropertyElemByTypeAndRole (p :: PropertyT
p : rest :: [PropertyT]
rest) classes :: [String]
classes pN :: String
pN =
  if (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (TypeClass -> String
CSMOFSign.name (PropertyT -> TypeClass
CSMOFSign.sourceType PropertyT
p)) [String]
classes Bool -> Bool -> Bool
&&
      PropertyT -> String
CSMOFSign.targetRole PropertyT
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pN) Bool -> Bool -> Bool
||
     (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (TypeClass -> String
CSMOFSign.name (PropertyT -> TypeClass
CSMOFSign.targetType PropertyT
p)) [String]
classes Bool -> Bool -> Bool
&&
      PropertyT -> String
CSMOFSign.sourceRole PropertyT
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pN)
  then PropertyT -> Maybe PropertyT
forall a. a -> Maybe a
Just PropertyT
p
  else [PropertyT] -> [String] -> String -> Maybe PropertyT
findPropertyElemByTypeAndRole [PropertyT]
rest [String]
classes String
pN


findOppProperty :: Rel.Rel CSMOFSign.TypeClass -> Set.Set CSMOFSign.PropertyT ->
                  String -> String -> String -> Bool
findOppProperty :: Rel TypeClass
-> Set PropertyT -> String -> String -> String -> Bool
findOppProperty typRel :: Rel TypeClass
typRel props :: Set PropertyT
props kType :: String
kType oppPType :: String
oppPType oppPName :: String
oppPName =
  let classes :: [String]
classes = String
oppPType String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Set String -> [String]
forall a. Set a -> [a]
Set.toList (Rel String -> String -> Set String
superClasses ((TypeClass -> String) -> Rel TypeClass -> Rel String
forall a b. (Ord a, Ord b) => (a -> b) -> Rel a -> Rel b
Rel.map TypeClass -> String
CSMOFSign.name Rel TypeClass
typRel)
                                        String
oppPType)
  in [PropertyT] -> [String] -> String -> String -> Bool
findOppPropertyByTypeAndRole (Set PropertyT -> [PropertyT]
forall a. Set a -> [a]
Set.toList Set PropertyT
props) [String]
classes String
oppPName String
kType


findOppPropertyByTypeAndRole :: [CSMOFSign.PropertyT] -> [String] -> String ->
                                String -> Bool
findOppPropertyByTypeAndRole :: [PropertyT] -> [String] -> String -> String -> Bool
findOppPropertyByTypeAndRole [] _ _ _ = Bool
False
findOppPropertyByTypeAndRole (p :: PropertyT
p : rest :: [PropertyT]
rest) classes :: [String]
classes pN :: String
pN kType :: String
kType =
 (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (TypeClass -> String
CSMOFSign.name (PropertyT -> TypeClass
CSMOFSign.sourceType PropertyT
p)) [String]
classes Bool -> Bool -> Bool
&&
       PropertyT -> String
CSMOFSign.targetRole PropertyT
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pN Bool -> Bool -> Bool
&&
       TypeClass -> String
CSMOFSign.name (PropertyT -> TypeClass
CSMOFSign.targetType PropertyT
p) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
kType) Bool -> Bool -> Bool
||
 (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (TypeClass -> String
CSMOFSign.name (PropertyT -> TypeClass
CSMOFSign.targetType PropertyT
p)) [String]
classes Bool -> Bool -> Bool
&&
       PropertyT -> String
CSMOFSign.sourceRole PropertyT
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pN Bool -> Bool -> Bool
&&
       TypeClass -> String
CSMOFSign.name (PropertyT -> TypeClass
CSMOFSign.sourceType PropertyT
p) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
kType) Bool -> Bool -> Bool
||
 [PropertyT] -> [String] -> String -> String -> Bool
findOppPropertyByTypeAndRole [PropertyT]
rest [String]
classes String
pN String
kType


getTargetType :: String -> CSMOFSign.PropertyT -> String
getTargetType :: String -> PropertyT -> String
getTargetType pN :: String
pN p :: PropertyT
p = TypeClass -> String
CSMOFSign.name (TypeClass -> String) -> TypeClass -> String
forall a b. (a -> b) -> a -> b
$
  if PropertyT -> String
CSMOFSign.targetRole PropertyT
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pN
  then PropertyT -> TypeClass
CSMOFSign.targetType PropertyT
p
  else PropertyT -> TypeClass
CSMOFSign.sourceType PropertyT
p


getOppositeType :: String -> CSMOFSign.PropertyT -> String
getOppositeType :: String -> PropertyT -> String
getOppositeType pN :: String
pN p :: PropertyT
p = TypeClass -> String
CSMOFSign.name (TypeClass -> String) -> TypeClass -> String
forall a b. (a -> b) -> a -> b
$
  if PropertyT -> String
CSMOFSign.sourceRole PropertyT
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
pN
  then PropertyT -> TypeClass
CSMOFSign.targetType PropertyT
p
  else PropertyT -> TypeClass
CSMOFSign.sourceType PropertyT
p


third :: (String, String, CSMOFAs.Metamodel) -> CSMOFAs.Metamodel
third :: (String, String, Metamodel) -> Metamodel
third (_, _, c :: Metamodel
c) = Metamodel
c


buildRules :: Sign -> (String, String, CSMOFAs.Metamodel) ->
              (String, String, CSMOFAs.Metamodel) ->
              [Relation] -> ([Named Sen], [Diagnosis])
buildRules :: Sign
-> (String, String, Metamodel)
-> (String, String, Metamodel)
-> [Relation]
-> ([Named Sen], [Diagnosis])
buildRules sign :: Sign
sign souMet :: (String, String, Metamodel)
souMet tarMet :: (String, String, Metamodel)
tarMet rul :: [Relation]
rul =
  let
    (rel :: [RelationSen]
rel, diag :: [Diagnosis]
diag) = Sign
-> (String, String, Metamodel)
-> (String, String, Metamodel)
-> [Relation]
-> ([RelationSen], [Diagnosis])
checkRules Sign
sign (String, String, Metamodel)
souMet (String, String, Metamodel)
tarMet [Relation]
rul
  in ((RelationSen -> Named Sen) -> [RelationSen] -> [Named Sen]
forall a b. (a -> b) -> [a] -> [b]
map (\ r :: RelationSen
r -> String -> Sen -> Named Sen
forall a s. a -> s -> SenAttr s a
makeNamed "" QVTSen :: RelationSen -> Sen
QVTSen { rule :: RelationSen
rule = RelationSen
r }) [RelationSen]
rel, [Diagnosis]
diag)


checkRules :: Sign -> (String, String, CSMOFAs.Metamodel) ->
              (String, String, CSMOFAs.Metamodel) ->
              [Relation] -> ([RelationSen], [Diagnosis])
checkRules :: Sign
-> (String, String, Metamodel)
-> (String, String, Metamodel)
-> [Relation]
-> ([RelationSen], [Diagnosis])
checkRules _ _ _ [] = ([], [])
checkRules sign :: Sign
sign souMet :: (String, String, Metamodel)
souMet tarMet :: (String, String, Metamodel)
tarMet (r :: Relation
r : rest :: [Relation]
rest) =
  let
    (rul :: [RelationSen]
rul, diag :: [Diagnosis]
diag) = Sign
-> (String, String, Metamodel)
-> (String, String, Metamodel)
-> Relation
-> ([RelationSen], [Diagnosis])
checkRule Sign
sign (String, String, Metamodel)
souMet (String, String, Metamodel)
tarMet Relation
r
    (restRul :: [RelationSen]
restRul, restDiag :: [Diagnosis]
restDiag) = Sign
-> (String, String, Metamodel)
-> (String, String, Metamodel)
-> [Relation]
-> ([RelationSen], [Diagnosis])
checkRules Sign
sign (String, String, Metamodel)
souMet (String, String, Metamodel)
tarMet [Relation]
rest
  in
    ([RelationSen]
rul [RelationSen] -> [RelationSen] -> [RelationSen]
forall a. [a] -> [a] -> [a]
++ [RelationSen]
restRul, [Diagnosis]
diag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
restDiag)


checkRule :: Sign -> (String, String, CSMOFAs.Metamodel) ->
             (String, String, CSMOFAs.Metamodel) -> Relation ->
             ([RelationSen], [Diagnosis])
checkRule :: Sign
-> (String, String, Metamodel)
-> (String, String, Metamodel)
-> Relation
-> ([RelationSen], [Diagnosis])
checkRule sign :: Sign
sign _ _ (Relation tp :: Bool
tp rN :: String
rN vS :: [RelVar]
vS prD :: [PrimitiveDomain]
prD souDom :: Domain
souDom tarDom :: Domain
tarDom whenC :: Maybe WhenWhere
whenC whereC :: Maybe WhenWhere
whereC) =
  let
    rName :: String
rName = if Bool
tp then "Top_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rN else String
rN

    (rDefNonTop :: RuleDef
rDefNonTop, rDiagNonTop :: [Diagnosis]
rDiagNonTop) = case String -> Map String RuleDef -> Maybe RuleDef
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
rN (Sign -> Map String RuleDef
nonTopRelations Sign
sign) of
                            Nothing -> (String -> Bool -> [TypeClass] -> RuleDef
RuleDef "" Bool
False [],
                             [DiagKind -> String -> String -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "non top relation not found" String
rName])
                            Just r :: RuleDef
r -> (RuleDef
r, [])

    (rDef :: RuleDef
rDef, rDiag :: [Diagnosis]
rDiag) = if Bool
tp
                   then case String -> Map String RuleDef -> Maybe RuleDef
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
rName (Sign -> Map String RuleDef
topRelations Sign
sign) of
                          Nothing -> (String -> Bool -> [TypeClass] -> RuleDef
RuleDef "" Bool
False [],
                           [DiagKind -> String -> String -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "top relation not found" String
rName])
                          Just r :: RuleDef
r -> (RuleDef
r, [])
                   else (String -> Bool -> [TypeClass] -> RuleDef
RuleDef "" Bool
False [], [])

    pSet :: [RelVar]
pSet = [PrimitiveDomain] -> Domain -> Domain -> [RelVar]
collectParSet [PrimitiveDomain]
prD Domain
souDom Domain
tarDom
    vSet :: [RelVar]
vSet = [RelVar] -> [PrimitiveDomain] -> Domain -> Domain -> [RelVar]
collectVarSet [RelVar]
vS [PrimitiveDomain]
prD Domain
souDom Domain
tarDom

    (souPat :: Pattern
souPat, diagSPat :: [Diagnosis]
diagSPat) = Domain -> Sign -> [RelVar] -> (Pattern, [Diagnosis])
buildPattern Domain
souDom (Sign -> Sign
sourceSign Sign
sign) [RelVar]
vSet
    (tarPat :: Pattern
tarPat, diagTPat :: [Diagnosis]
diagTPat) = Domain -> Sign -> [RelVar] -> (Pattern, [Diagnosis])
buildPattern Domain
tarDom (Sign -> Sign
targetSign Sign
sign) [RelVar]
vSet
    (whenCl :: Maybe WhenWhere
whenCl, diagW1Pat :: [Diagnosis]
diagW1Pat) = Maybe WhenWhere -> (Maybe WhenWhere, [Diagnosis])
checkWhenWhere Maybe WhenWhere
whenC
    (whereCl :: Maybe WhenWhere
whereCl, diagW2Pat :: [Diagnosis]
diagW2Pat) = Maybe WhenWhere -> (Maybe WhenWhere, [Diagnosis])
checkWhenWhere Maybe WhenWhere
whereC

  in
    if Bool
tp
    then (RuleDef
-> [RelVar]
-> [RelVar]
-> Pattern
-> Pattern
-> Maybe WhenWhere
-> Maybe WhenWhere
-> RelationSen
RelationSen RuleDef
rDef [RelVar]
vSet [] Pattern
souPat Pattern
tarPat Maybe WhenWhere
whenCl Maybe WhenWhere
whereCl RelationSen -> [RelationSen] -> [RelationSen]
forall a. a -> [a] -> [a]
: -- Top Rule
            [RuleDef
-> [RelVar]
-> [RelVar]
-> Pattern
-> Pattern
-> Maybe WhenWhere
-> Maybe WhenWhere
-> RelationSen
RelationSen RuleDef
rDefNonTop [RelVar]
vSet [RelVar]
pSet Pattern
souPat Pattern
tarPat Maybe WhenWhere
whenCl Maybe WhenWhere
whereCl], -- Non Top Rule
               [Diagnosis]
rDiag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
rDiagNonTop [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diagSPat [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diagTPat [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diagW1Pat [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diagW2Pat)
    else ([RuleDef
-> [RelVar]
-> [RelVar]
-> Pattern
-> Pattern
-> Maybe WhenWhere
-> Maybe WhenWhere
-> RelationSen
RelationSen RuleDef
rDefNonTop [RelVar]
vSet [RelVar]
pSet Pattern
souPat Pattern
tarPat Maybe WhenWhere
whenCl Maybe WhenWhere
whereCl],
            [Diagnosis]
rDiag [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
rDiagNonTop [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diagSPat [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diagTPat [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diagW1Pat [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
diagW2Pat)


collectParSet :: [PrimitiveDomain] -> Domain -> Domain -> [RelVar]
collectParSet :: [PrimitiveDomain] -> Domain -> Domain -> [RelVar]
collectParSet prD :: [PrimitiveDomain]
prD souDom :: Domain
souDom tarDom :: Domain
tarDom =
  let
    prDVS :: [RelVar]
prDVS = [PrimitiveDomain] -> [RelVar]
collectPrimDomVarSet [PrimitiveDomain]
prD
    souVar :: RelVar
souVar = String -> String -> RelVar
RelVar (ObjectTemplate -> String
domType (ObjectTemplate -> String) -> ObjectTemplate -> String
forall a b. (a -> b) -> a -> b
$ Domain -> ObjectTemplate
template Domain
souDom) (ObjectTemplate -> String
domVar (ObjectTemplate -> String) -> ObjectTemplate -> String
forall a b. (a -> b) -> a -> b
$ Domain -> ObjectTemplate
template Domain
souDom)
    tarVar :: RelVar
tarVar = String -> String -> RelVar
RelVar (ObjectTemplate -> String
domType (ObjectTemplate -> String) -> ObjectTemplate -> String
forall a b. (a -> b) -> a -> b
$ Domain -> ObjectTemplate
template Domain
tarDom) (ObjectTemplate -> String
domVar (ObjectTemplate -> String) -> ObjectTemplate -> String
forall a b. (a -> b) -> a -> b
$ Domain -> ObjectTemplate
template Domain
tarDom)
  in
    [RelVar
souVar, RelVar
tarVar] [RelVar] -> [RelVar] -> [RelVar]
forall a. [a] -> [a] -> [a]
++ [RelVar]
prDVS


collectVarSet :: [RelVar] -> [PrimitiveDomain] -> Domain -> Domain -> [RelVar]
collectVarSet :: [RelVar] -> [PrimitiveDomain] -> Domain -> Domain -> [RelVar]
collectVarSet varS :: [RelVar]
varS prD :: [PrimitiveDomain]
prD souDom :: Domain
souDom tarDom :: Domain
tarDom =
  let
    souDomVS :: [RelVar]
souDomVS = Domain -> [RelVar]
collectDomainVarSet Domain
souDom
    tarDomVS :: [RelVar]
tarDomVS = Domain -> [RelVar]
collectDomainVarSet Domain
tarDom
    prDVS :: [RelVar]
prDVS = [PrimitiveDomain] -> [RelVar]
collectPrimDomVarSet [PrimitiveDomain]
prD
  in
    [RelVar]
varS [RelVar] -> [RelVar] -> [RelVar]
forall a. [a] -> [a] -> [a]
++ [RelVar]
prDVS [RelVar] -> [RelVar] -> [RelVar]
forall a. [a] -> [a] -> [a]
++ [RelVar]
souDomVS [RelVar] -> [RelVar] -> [RelVar]
forall a. [a] -> [a] -> [a]
++ [RelVar]
tarDomVS


collectPrimDomVarSet :: [PrimitiveDomain] -> [RelVar]
collectPrimDomVarSet :: [PrimitiveDomain] -> [RelVar]
collectPrimDomVarSet = (PrimitiveDomain -> RelVar) -> [PrimitiveDomain] -> [RelVar]
forall a b. (a -> b) -> [a] -> [b]
map (\ n :: PrimitiveDomain
n -> String -> String -> RelVar
RelVar (PrimitiveDomain -> String
primType PrimitiveDomain
n) (PrimitiveDomain -> String
primName PrimitiveDomain
n))


collectDomainVarSet :: Domain -> [RelVar]
collectDomainVarSet :: Domain -> [RelVar]
collectDomainVarSet dom :: Domain
dom = Maybe ObjectTemplate -> [RelVar]
collectRecursiveVars (ObjectTemplate -> Maybe ObjectTemplate
forall a. a -> Maybe a
Just (ObjectTemplate -> Maybe ObjectTemplate)
-> ObjectTemplate -> Maybe ObjectTemplate
forall a b. (a -> b) -> a -> b
$ Domain -> ObjectTemplate
template Domain
dom)


collectRecursiveVars :: Maybe ObjectTemplate -> [RelVar]
collectRecursiveVars :: Maybe ObjectTemplate -> [RelVar]
collectRecursiveVars Nothing = []
collectRecursiveVars (Just ot :: ObjectTemplate
ot) =
  let otVar :: RelVar
otVar = String -> String -> RelVar
RelVar (ObjectTemplate -> String
domType ObjectTemplate
ot) (ObjectTemplate -> String
domVar ObjectTemplate
ot)
  in
    RelVar
otVar RelVar -> [RelVar] -> [RelVar]
forall a. a -> [a] -> [a]
: (PropertyTemplate -> [RelVar] -> [RelVar])
-> [RelVar] -> [PropertyTemplate] -> [RelVar]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([RelVar] -> [RelVar] -> [RelVar]
forall a. [a] -> [a] -> [a]
(++) ([RelVar] -> [RelVar] -> [RelVar])
-> (PropertyTemplate -> [RelVar])
-> PropertyTemplate
-> [RelVar]
-> [RelVar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ObjectTemplate -> [RelVar]
collectRecursiveVars (Maybe ObjectTemplate -> [RelVar])
-> (PropertyTemplate -> Maybe ObjectTemplate)
-> PropertyTemplate
-> [RelVar]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropertyTemplate -> Maybe ObjectTemplate
objTemp) [] (ObjectTemplate -> [PropertyTemplate]
templateList ObjectTemplate
ot)


buildPattern :: Domain -> CSMOFSign.Sign -> [RelVar] -> (Pattern, [Diagnosis])
buildPattern :: Domain -> Sign -> [RelVar] -> (Pattern, [Diagnosis])
buildPattern dom :: Domain
dom sign :: Sign
sign vSet :: [RelVar]
vSet =
  let
    (patR :: [(PropertyT, RelVar, RelVar)]
patR, diag :: [Diagnosis]
diag) = String
-> String
-> [PropertyTemplate]
-> Sign
-> [RelVar]
-> ([(PropertyT, RelVar, RelVar)], [Diagnosis])
collectRecursiveRelInvoc (ObjectTemplate -> String
domVar (Domain -> ObjectTemplate
template Domain
dom))
     (ObjectTemplate -> String
domType (Domain -> ObjectTemplate
template Domain
dom)) (ObjectTemplate -> [PropertyTemplate]
templateList (Domain -> ObjectTemplate
template Domain
dom)) Sign
sign [RelVar]
vSet
    patPr :: [(String, String, OCL)]
patPr = [RelVar] -> Maybe ObjectTemplate -> [(String, String, OCL)]
collectRecursivePreds [RelVar]
vSet (ObjectTemplate -> Maybe ObjectTemplate
forall a. a -> Maybe a
Just (ObjectTemplate -> Maybe ObjectTemplate)
-> ObjectTemplate -> Maybe ObjectTemplate
forall a b. (a -> b) -> a -> b
$ Domain -> ObjectTemplate
template Domain
dom)
  in
    ([RelVar]
-> [(PropertyT, RelVar, RelVar)]
-> [(String, String, OCL)]
-> Pattern
Pattern (Domain -> [RelVar]
collectDomainVarSet Domain
dom) [(PropertyT, RelVar, RelVar)]
patR [(String, String, OCL)]
patPr, [Diagnosis]
diag)


collectRecursiveRelInvoc :: String -> String -> [PropertyTemplate] ->
                            CSMOFSign.Sign -> [RelVar] ->
                            ([(CSMOFSign.PropertyT, RelVar, RelVar)],
                             [Diagnosis])
collectRecursiveRelInvoc :: String
-> String
-> [PropertyTemplate]
-> Sign
-> [RelVar]
-> ([(PropertyT, RelVar, RelVar)], [Diagnosis])
collectRecursiveRelInvoc _ _ [] _ _ = ([], [])
collectRecursiveRelInvoc nam :: String
nam typ :: String
typ (pt :: PropertyTemplate
pt : restPT :: [PropertyTemplate]
restPT) sign :: Sign
sign vSet :: [RelVar]
vSet =
  case PropertyTemplate -> Maybe ObjectTemplate
objTemp PropertyTemplate
pt of
    Nothing -> ([], [])
    Just ot :: ObjectTemplate
ot ->
      let
        prop :: Maybe PropertyT
prop = Rel TypeClass
-> Set PropertyT -> String -> String -> Maybe PropertyT
findPropertyInHierarchy (Sign -> Rel TypeClass
CSMOFSign.typeRel Sign
sign)
         (Sign -> Set PropertyT
CSMOFSign.properties Sign
sign) String
typ (PropertyTemplate -> String
pName PropertyTemplate
pt)
        (restProps :: [(PropertyT, RelVar, RelVar)]
restProps, diagn :: [Diagnosis]
diagn) = String
-> String
-> [PropertyTemplate]
-> Sign
-> [RelVar]
-> ([(PropertyT, RelVar, RelVar)], [Diagnosis])
collectRecursiveRelInvoc String
nam String
typ [PropertyTemplate]
restPT Sign
sign [RelVar]
vSet
        (recPr :: [(PropertyT, RelVar, RelVar)]
recPr, recDiag :: [Diagnosis]
recDiag) = String
-> String
-> [PropertyTemplate]
-> Sign
-> [RelVar]
-> ([(PropertyT, RelVar, RelVar)], [Diagnosis])
collectRecursiveRelInvoc (ObjectTemplate -> String
domVar ObjectTemplate
ot)
         (ObjectTemplate -> String
domType ObjectTemplate
ot) (ObjectTemplate -> [PropertyTemplate]
templateList ObjectTemplate
ot) Sign
sign [RelVar]
vSet
      in
        case Maybe PropertyT
prop of
          Nothing -> ([], DiagKind -> String -> PropertyTemplate -> Diagnosis
forall a.
(GetRange a, Pretty a) =>
DiagKind -> String -> a -> Diagnosis
mkDiag DiagKind
Error "property not found" PropertyTemplate
pt Diagnosis -> [Diagnosis] -> [Diagnosis]
forall a. a -> [a] -> [a]
:
                           ([Diagnosis]
diagn [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
recDiag))
          Just p :: PropertyT
p -> let
                      souV :: RelVar
souV = String -> String -> RelVar
RelVar String
typ String
nam
                      tarV :: Maybe RelVar
tarV = PropertyTemplate -> [RelVar] -> Maybe RelVar
getVarFromTemplate PropertyTemplate
pt [RelVar]
vSet
                    in
                      case Maybe RelVar
tarV of
                       Nothing -> ([(PropertyT, RelVar, RelVar)]
restProps [(PropertyT, RelVar, RelVar)]
-> [(PropertyT, RelVar, RelVar)] -> [(PropertyT, RelVar, RelVar)]
forall a. [a] -> [a] -> [a]
++ [(PropertyT, RelVar, RelVar)]
recPr, [Diagnosis]
diagn [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
recDiag)
                        -- it is a OCL expression, not a variable
                       Just relVar :: RelVar
relVar -> ((PropertyT
p, RelVar
souV, RelVar
relVar) (PropertyT, RelVar, RelVar)
-> [(PropertyT, RelVar, RelVar)] -> [(PropertyT, RelVar, RelVar)]
forall a. a -> [a] -> [a]
: ([(PropertyT, RelVar, RelVar)]
restProps [(PropertyT, RelVar, RelVar)]
-> [(PropertyT, RelVar, RelVar)] -> [(PropertyT, RelVar, RelVar)]
forall a. [a] -> [a] -> [a]
++ [(PropertyT, RelVar, RelVar)]
recPr),
                                        [Diagnosis]
diagn [Diagnosis] -> [Diagnosis] -> [Diagnosis]
forall a. [a] -> [a] -> [a]
++ [Diagnosis]
recDiag)


getVarFromTemplate :: PropertyTemplate -> [RelVar] -> Maybe RelVar
getVarFromTemplate :: PropertyTemplate -> [RelVar] -> Maybe RelVar
getVarFromTemplate (PropertyTemplate _ ocl :: Maybe OCL
ocl _) relV :: [RelVar]
relV =
  case Maybe OCL
ocl of
    Nothing -> Maybe RelVar
forall a. Maybe a
Nothing
    Just (StringExp (VarExp v :: String
v)) -> String -> [RelVar] -> Maybe RelVar
findVarFromName String
v [RelVar]
relV
    _ -> Maybe RelVar
forall a. Maybe a
Nothing


findVarFromName :: String -> [RelVar] -> Maybe RelVar
findVarFromName :: String -> [RelVar] -> Maybe RelVar
findVarFromName _ [] = Maybe RelVar
forall a. Maybe a
Nothing
findVarFromName nam :: String
nam (v :: RelVar
v : restV :: [RelVar]
restV) = if RelVar -> String
varName RelVar
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
nam
                                  then RelVar -> Maybe RelVar
forall a. a -> Maybe a
Just RelVar
v
                                  else String -> [RelVar] -> Maybe RelVar
findVarFromName String
nam [RelVar]
restV


collectRecursivePreds :: [RelVar] -> Maybe ObjectTemplate ->
                         [(String, String, OCL)]
collectRecursivePreds :: [RelVar] -> Maybe ObjectTemplate -> [(String, String, OCL)]
collectRecursivePreds _ Nothing = []
collectRecursivePreds vSet :: [RelVar]
vSet (Just ot :: ObjectTemplate
ot) =
  let
    tList :: [PropertyTemplate]
tList = ObjectTemplate -> [PropertyTemplate]
templateList ObjectTemplate
ot
    oclExps :: [(String, String, OCL)]
oclExps = (PropertyTemplate
 -> [(String, String, OCL)] -> [(String, String, OCL)])
-> [(String, String, OCL)]
-> [PropertyTemplate]
-> [(String, String, OCL)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([(String, String, OCL)]
-> [(String, String, OCL)] -> [(String, String, OCL)]
forall a. [a] -> [a] -> [a]
(++) ([(String, String, OCL)]
 -> [(String, String, OCL)] -> [(String, String, OCL)])
-> (PropertyTemplate -> [(String, String, OCL)])
-> PropertyTemplate
-> [(String, String, OCL)]
-> [(String, String, OCL)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [RelVar] -> PropertyTemplate -> [(String, String, OCL)]
getOclExpre (ObjectTemplate -> String
domVar ObjectTemplate
ot) [RelVar]
vSet) [] [PropertyTemplate]
tList
  in
    [(String, String, OCL)]
oclExps [(String, String, OCL)]
-> [(String, String, OCL)] -> [(String, String, OCL)]
forall a. [a] -> [a] -> [a]
++ (PropertyTemplate
 -> [(String, String, OCL)] -> [(String, String, OCL)])
-> [(String, String, OCL)]
-> [PropertyTemplate]
-> [(String, String, OCL)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([(String, String, OCL)]
-> [(String, String, OCL)] -> [(String, String, OCL)]
forall a. [a] -> [a] -> [a]
(++) ([(String, String, OCL)]
 -> [(String, String, OCL)] -> [(String, String, OCL)])
-> (PropertyTemplate -> [(String, String, OCL)])
-> PropertyTemplate
-> [(String, String, OCL)]
-> [(String, String, OCL)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [RelVar] -> Maybe ObjectTemplate -> [(String, String, OCL)]
collectRecursivePreds [RelVar]
vSet (Maybe ObjectTemplate -> [(String, String, OCL)])
-> (PropertyTemplate -> Maybe ObjectTemplate)
-> PropertyTemplate
-> [(String, String, OCL)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropertyTemplate -> Maybe ObjectTemplate
objTemp) [] [PropertyTemplate]
tList


getOclExpre :: String -> [RelVar] -> PropertyTemplate -> [(String, String, OCL)]
getOclExpre :: String -> [RelVar] -> PropertyTemplate -> [(String, String, OCL)]
getOclExpre otN :: String
otN _ (PropertyTemplate pN :: String
pN ocl :: Maybe OCL
ocl objT :: Maybe ObjectTemplate
objT) =
  case Maybe OCL
ocl of
    Nothing -> case Maybe ObjectTemplate
objT of
                 Nothing -> []
                 Just o :: ObjectTemplate
o -> [(String
pN, String
otN, STRING -> OCL
StringExp (String -> STRING
VarExp (ObjectTemplate -> String
domVar ObjectTemplate
o)))]
                  -- ToDo Diagnosis
    Just s :: OCL
s -> [(String
pN, String
otN, OCL
s)] -- ToDo Diagnosis


checkWhenWhere :: Maybe WhenWhere -> (Maybe WhenWhere, [Diagnosis])
checkWhenWhere :: Maybe WhenWhere -> (Maybe WhenWhere, [Diagnosis])
checkWhenWhere ww :: Maybe WhenWhere
ww = (Maybe WhenWhere
ww, []) -- ToDo Diagnosis


{- ToDo :: Diagnosis
  las Keys no son vacias
  los tipos en RelVar existen
  los tipos en PrimitiveDomain existen
  los nombres de variables en RelVar, PrimitiveDomain, Domain no se repiten
  el domModelId del source y target Domain son los de la transformacion
  los domMeta del source (de todos los obj templ) es el del source de la trans. Idem para el target
  los domType del source y target existen en el source y target meta, respectivamente
  los pName son propiedades que existen en cada domType
  no hago nada con las oclExpre
  para cada RelInVok de un WhenWhere, el nombre de la regla existe
  para cada RelInvok los parametros son variables definidas y tienen los tipos de la relacion -}


-- Get every ObjectTemplate from a Domain (recursive)
getObjectTemplates :: Domain -> [ObjectTemplate]
getObjectTemplates :: Domain -> [ObjectTemplate]
getObjectTemplates dom :: Domain
dom = Domain -> ObjectTemplate
template Domain
dom ObjectTemplate -> [ObjectTemplate] -> [ObjectTemplate]
forall a. a -> [a] -> [a]
: ObjectTemplate -> [ObjectTemplate]
getObjectTemplatesFromOT (Domain -> ObjectTemplate
template Domain
dom)

getObjectTemplatesFromOT :: ObjectTemplate -> [ObjectTemplate]
getObjectTemplatesFromOT :: ObjectTemplate -> [ObjectTemplate]
getObjectTemplatesFromOT ot :: ObjectTemplate
ot =
  let otList :: [ObjectTemplate]
otList = [PropertyTemplate] -> [ObjectTemplate]
getOT ([PropertyTemplate] -> [ObjectTemplate])
-> [PropertyTemplate] -> [ObjectTemplate]
forall a b. (a -> b) -> a -> b
$ ObjectTemplate -> [PropertyTemplate]
templateList ObjectTemplate
ot
  in (ObjectTemplate -> [ObjectTemplate] -> [ObjectTemplate])
-> [ObjectTemplate] -> [ObjectTemplate] -> [ObjectTemplate]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([ObjectTemplate] -> [ObjectTemplate] -> [ObjectTemplate]
forall a. [a] -> [a] -> [a]
(++) ([ObjectTemplate] -> [ObjectTemplate] -> [ObjectTemplate])
-> (ObjectTemplate -> [ObjectTemplate])
-> ObjectTemplate
-> [ObjectTemplate]
-> [ObjectTemplate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectTemplate -> [ObjectTemplate]
getObjectTemplatesFromOT) [] [ObjectTemplate]
otList

getOT :: [PropertyTemplate] -> [ObjectTemplate]
getOT :: [PropertyTemplate] -> [ObjectTemplate]
getOT list :: [PropertyTemplate]
list =
  case [PropertyTemplate]
list of
    [] -> []
    el :: PropertyTemplate
el : rest :: [PropertyTemplate]
rest -> case PropertyTemplate -> Maybe ObjectTemplate
objTemp PropertyTemplate
el of
                   Nothing -> [PropertyTemplate] -> [ObjectTemplate]
getOT [PropertyTemplate]
rest
                   Just typ :: ObjectTemplate
typ -> ObjectTemplate
typ ObjectTemplate -> [ObjectTemplate] -> [ObjectTemplate]
forall a. a -> [a] -> [a]
: [PropertyTemplate] -> [ObjectTemplate]
getOT [PropertyTemplate]
rest