content: {- |
  Module      :  ./QVTR/Print.hs
  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
  