{-# LANGUAGE DeriveDataTypeable #-}
{- |
Module : ./QVTR/Sign.hs
Description : QVTR signature and sentences
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.Sign where
import QVTR.As
import QVTR.Print ()
import qualified CSMOF.Sign as CSMOF
import CSMOF.Print ()
import Common.Doc
import Common.DocUtils
import Common.Id
import Data.Data
import qualified Data.Map as Map
data RuleDef = RuleDef { name :: String
, top :: Bool
, parameters :: [CSMOF.TypeClass]
} deriving (Show, Eq, Ord, Typeable, Data)
instance Pretty RuleDef where
pretty (RuleDef nam to pars) =
let t = text $ if to
then "top relation"
else "relation"
in t <+> text nam <> lparen
<> foldr ((<+>) . pretty) empty pars
<> rparen
data Sign = Sign { sourceSign :: CSMOF.Sign
, targetSign :: CSMOF.Sign
, nonTopRelations :: Map.Map String RuleDef
, topRelations :: Map.Map String RuleDef
, keyDefs :: [(String, String)]
} deriving (Show, Eq, Ord, Typeable, Data)
instance GetRange Sign where
getRange _ = nullRange
rangeSpan _ = []
instance Pretty Sign where
pretty (Sign souS tarS nonRel topRel keyD) =
text "-- Source Metamodel"
$++$
pretty souS
$++$
text "-- Target Metamodel"
$++$
pretty tarS
$++$
text "-- Model Transformation"
$++$
text "Definition of Relations"
$+$
Map.fold (($+$) . pretty) empty topRel
$+$
Map.fold (($+$) . pretty) empty nonRel
$++$
text "Definition of Keys"
$+$
foldr (($+$) . pretty) empty keyD
emptySign :: Sign
emptySign = Sign { sourceSign = CSMOF.emptySign
, targetSign = CSMOF.emptySign
, nonTopRelations = Map.empty
, topRelations = Map.empty
, keyDefs = []
}
data Sen = KeyConstr { keyConst :: Key }
| QVTSen { rule :: RelationSen }
deriving (Show, Eq, Ord, Typeable, Data)
instance GetRange Sen where
getRange _ = nullRange
rangeSpan _ = []
instance Pretty Sen where
pretty (KeyConstr con) = pretty con
pretty (QVTSen rel) = pretty rel
data RelationSen = RelationSen { ruleDef :: RuleDef
, varSet :: [RelVar]
, parSet :: [RelVar]
, sourcePattern :: Pattern
, targetPattern :: Pattern
, whenClause :: Maybe WhenWhere
, whereClause :: Maybe WhenWhere
} deriving (Show, Eq, Ord, Typeable, Data)
instance GetRange RelationSen where
getRange _ = nullRange
rangeSpan _ = []
instance Pretty RelationSen where
pretty (RelationSen rD vS pS souP tarP whenC whereC) =
pretty rD
$++$
text "Variables" <> colon <+> foldr ((<+>) . pretty) empty vS
$++$
text "Parameters" <> colon <+> foldr ((<+>) . pretty) empty pS
$++$
pretty souP
$++$
pretty tarP
$++$
(case whenC of
Nothing -> text "When" <+> lbrace $+$ rbrace
Just w -> text "When" <+> lbrace $+$ pretty w $+$ rbrace)
$++$
(case whereC of
Nothing -> text "Where" <+> lbrace $+$ rbrace
Just w -> text "Where" <+> lbrace $+$ pretty w $+$ rbrace)
data Pattern = Pattern { patVarSet :: [RelVar]
, patRels :: [(CSMOF.PropertyT, RelVar, RelVar)]
, patPreds :: [(String, String, OCL)]
} deriving (Show, Eq, Ord, Typeable, Data)
instance GetRange Pattern where
getRange _ = nullRange
rangeSpan _ = []
instance Pretty Pattern where
pretty (Pattern patVS patRel patPre) =
text "Pattern" <+> lbrace
$+$
space <+> space <+> text "Variables" <> colon <+> foldr ((<+>) . pretty) empty patVS
$+$
space <+> space <+> text "Relations" <> colon <+> foldr (($+$) . pretty) empty patRel
$+$
space <+> space <+> text "Predicates" <> colon <+> foldr (($+$) . pretty) empty patPre
$+$
rbrace