{- |

Module : $Header$

Description : pretty printing for QVTR

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.Print where

import QVTR.As

import CSMOF.Print ()

import Common.Doc

import Common.DocUtils

printCol :: Pretty a => [a] -> Doc

printCol a = space <+> space <+> foldr (($+$) . pretty) empty a

instance Pretty Transformation where

pretty (Transformation nam (souNam, souMet, souAS) (tarNam, tarMet, tarAS) keS rels) =

text "-- Source Metamodel" <> colon <+> text souMet

$++$

pretty souAS

$++$

text "-- Target Metamodel" <> colon <+> text tarMet

$++$ pretty tarAS

$++$ text "transformation" <+> text nam <> lparen

<> text souNam <> colon <> text souMet <> comma

<+> text tarNam <> colon <> text tarMet <> rparen

$+$ lbrace $++$

(if not (null keS) && not (null rels) then

printCol keS $++$ printCol rels $++$ rbrace

else if not (null keS) then

printCol keS $++$ rbrace

else if not (null rels) then

printCol rels $++$ rbrace

else rbrace)

instance Show Transformation where

show m = show $ pretty m

instance Pretty Key where

pretty (Key met typN pro) =

text "key" <+> text met <> colon <> colon <> text typN

<+> lbrace <> foldr ((<+>) . pretty) empty pro <> rbrace

instance Show Key where

show m = show $ pretty m

instance Pretty PropKey where

pretty (SimpleProp nam) = text nam

pretty (OppositeProp typ nam) = text "opposite" <> lparen <> text typ <> dot

<> text nam <> rparen

instance Show PropKey where

show m = show $ pretty m

instance Pretty Relation where

pretty (Relation to reln vars primD souD tarD whenC whereC) =

text (if to then "top relation" else "relation") <+> text reln <+>

lbrace $++$ (if not (null vars) && not (null primD) then

printCol vars $++$ printCol primD

else if not (null vars) then

printCol vars

else if not (null primD) then

printCol primD

else space)

$++$ space <+> space <+> pretty souD

$++$ space <+> space <+> pretty tarD

$++$

(case whenC of

Nothing -> case whereC of

Nothing -> rbrace

Just whereCon -> space <+> space <+> text "Where" <+> lbrace

$+$ space <+> space <+> pretty whereCon

$+$ space <+> space <+> rbrace $++$ rbrace

Just whenCon -> case whereC of

Nothing -> space <+> space <+> text "When" <+> lbrace

$+$ space <+> space <+> pretty whenCon

$+$ space <+> space <+> rbrace

$++$ rbrace

Just whereCon -> space <+> space <+> text "When" <+> lbrace

$+$ space <+> space <+> pretty whenCon

$+$ space <+> space <+> rbrace

$++$ space <+> space <+> text "Where" <+> lbrace

$+$ space <+> space <+> pretty whereCon

$+$ space <+> space <+> rbrace

$++$ rbrace)

instance Show Relation where

show m = show $ pretty m

instance Pretty PrimitiveDomain where

pretty (PrimitiveDomain nam typ) = text "primitive domain" <+> text nam

<> colon <> text typ

instance Show PrimitiveDomain where

show m = show $ pretty m

instance Pretty RelVar where

pretty (RelVar typ nam) = text nam <> colon <> text typ

instance Show RelVar where

show m = show $ pretty m

instance Pretty Domain where

pretty (Domain dom tem) =

text "domain" <+> text dom

$+$ space <+> space <+> pretty tem

instance Show Domain where

show m = show $ pretty m

instance Pretty ObjectTemplate where

pretty (ObjectTemplate var met typ temL) =

text var <+> colon <+> text met <> colon <> colon <> text typ <+> lbrace

$+$ space <+> space <+> foldr (($+$) . pretty) empty temL

$+$ rbrace

instance Show ObjectTemplate where

show m = show $ pretty m

instance Pretty PropertyTemplate where

pretty (PropertyTemplate nam expr tem) =

text nam <+> text "="

<+> (case expr of

Nothing -> case tem of

Nothing -> empty

Just t -> pretty t

Just e -> case tem of

Nothing -> pretty e

Just t -> pretty e <+> pretty t

)

instance Show PropertyTemplate where

show m = show $ pretty m

instance Pretty WhenWhere where

pretty (WhenWhere inv ocl)

| null inv =

if null ocl

then space

else space <+> space <+> foldr (($+$) . pretty) empty ocl

| null ocl = space <+> space <+> foldr (($+$) . pretty) empty inv

| otherwise = space <+> space <+> foldr (($+$) . pretty) empty inv

$+$ space <+> space <+> foldr (($+$) . pretty) empty ocl

instance Show WhenWhere where

show m = show $ pretty m

instance Pretty RelInvok where

pretty (RelInvok nam par) = text nam <> lparen <> foldr ((<+>) . pretty)

empty par <> rparen

instance Show RelInvok where

show m = show $ pretty m

-- Print Fake OCL expressions

instance Pretty OCL where

pretty (Paren ex) = lparen <+> pretty ex <+> rparen

pretty (StringExp strE) = pretty strE

pretty (BExp e) = text $ if e then "TRUE" else "FALSE"

pretty (NotB e) = text "NOT" <+> lparen <+> pretty e <+> rparen

pretty (AndB lE rE) = lparen <+> pretty lE <+> rparen <+> text "AND" <+>

lparen <+> pretty rE <+> rparen

pretty (OrB lE rE) = lparen <+> pretty lE <+> rparen <+> text "OR" <+>

lparen <+> pretty rE <+> rparen

pretty (Equal lE rE) = lparen <+> pretty lE <+> rparen <+> text "=" <+>

lparen <+> pretty rE <+> rparen

instance Show OCL where

show m = show $ pretty m

instance Pretty STRING where

pretty (Str e) = text "'" <> text e <> text "'"

pretty (ConcatExp lE rE) = pretty lE <+> text "+" <+> pretty rE

pretty (VarExp varE) = pretty varE

instance Show STRING where

show m = show $ pretty m