{- |
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] -> Doc
printCol a :: [a]
a = Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> (a -> Doc -> Doc) -> Doc -> [a] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) (Doc -> Doc -> Doc) -> (a -> Doc) -> a -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
forall a. Pretty a => a -> Doc
pretty) Doc
empty [a]
a


instance Pretty Transformation where
  pretty :: Transformation -> Doc
pretty (Transformation nam :: String
nam (souNam :: String
souNam, souMet :: String
souMet, souAS :: Metamodel
souAS) (tarNam :: String
tarNam, tarMet :: String
tarMet, tarAS :: Metamodel
tarAS) keS :: [Key]
keS rels :: [Relation]
rels) =
    String -> Doc
text "-- Source Metamodel" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text String
souMet
    Doc -> Doc -> Doc
$++$
    Metamodel -> Doc
forall a. Pretty a => a -> Doc
pretty Metamodel
souAS
    Doc -> Doc -> Doc
$++$
    String -> Doc
text "-- Target Metamodel" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text String
tarMet
    Doc -> Doc -> Doc
$++$ Metamodel -> Doc
forall a. Pretty a => a -> Doc
pretty Metamodel
tarAS
    Doc -> Doc -> Doc
$++$ String -> Doc
text "transformation" Doc -> Doc -> Doc
<+> String -> Doc
text String
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
lparen
      Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
souNam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
souMet Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma
      Doc -> Doc -> Doc
<+> String -> Doc
text String
tarNam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
tarMet Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rparen
    Doc -> Doc -> Doc
$+$ Doc
lbrace Doc -> Doc -> Doc
$++$
    (if Bool -> Bool
not ([Key] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Key]
keS) Bool -> Bool -> Bool
&& Bool -> Bool
not ([Relation] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Relation]
rels) then
       [Key] -> Doc
forall a. Pretty a => [a] -> Doc
printCol [Key]
keS Doc -> Doc -> Doc
$++$ [Relation] -> Doc
forall a. Pretty a => [a] -> Doc
printCol [Relation]
rels Doc -> Doc -> Doc
$++$ Doc
rbrace
     else if Bool -> Bool
not ([Key] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Key]
keS) then
            [Key] -> Doc
forall a. Pretty a => [a] -> Doc
printCol [Key]
keS Doc -> Doc -> Doc
$++$ Doc
rbrace
          else if Bool -> Bool
not ([Relation] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Relation]
rels) then
                 [Relation] -> Doc
forall a. Pretty a => [a] -> Doc
printCol [Relation]
rels Doc -> Doc -> Doc
$++$ Doc
rbrace
               else Doc
rbrace)

instance Show Transformation where
  show :: Transformation -> String
show m :: Transformation
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Transformation -> Doc
forall a. Pretty a => a -> Doc
pretty Transformation
m


instance Pretty Key where
  pretty :: Key -> Doc
pretty (Key met :: String
met typN :: String
typN pro :: [PropKey]
pro) =
    String -> Doc
text "key" Doc -> Doc -> Doc
<+> String -> Doc
text String
met Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
typN
    Doc -> Doc -> Doc
<+> Doc
lbrace Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (PropKey -> Doc -> Doc) -> Doc -> [PropKey] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
(<+>) (Doc -> Doc -> Doc) -> (PropKey -> Doc) -> PropKey -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropKey -> Doc
forall a. Pretty a => a -> Doc
pretty) Doc
empty [PropKey]
pro Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbrace

instance Show Key where
  show :: Key -> String
show m :: Key
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Key -> Doc
forall a. Pretty a => a -> Doc
pretty Key
m


instance Pretty PropKey where
  pretty :: PropKey -> Doc
pretty (SimpleProp nam :: String
nam) = String -> Doc
text String
nam
  pretty (OppositeProp typ :: String
typ nam :: String
nam) = String -> Doc
text "opposite" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
lparen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
typ Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
dot
   Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rparen

instance Show PropKey where
  show :: PropKey -> String
show m :: PropKey
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ PropKey -> Doc
forall a. Pretty a => a -> Doc
pretty PropKey
m


instance Pretty Relation where
  pretty :: Relation -> Doc
pretty (Relation to :: Bool
to reln :: String
reln vars :: [RelVar]
vars primD :: [PrimitiveDomain]
primD souD :: Domain
souD tarD :: Domain
tarD whenC :: Maybe WhenWhere
whenC whereC :: Maybe WhenWhere
whereC) =
    String -> Doc
text (if Bool
to then "top relation" else "relation") Doc -> Doc -> Doc
<+> String -> Doc
text String
reln Doc -> Doc -> Doc
<+>
    Doc
lbrace Doc -> Doc -> Doc
$++$ (if Bool -> Bool
not ([RelVar] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RelVar]
vars) Bool -> Bool -> Bool
&& Bool -> Bool
not ([PrimitiveDomain] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PrimitiveDomain]
primD) then
       [RelVar] -> Doc
forall a. Pretty a => [a] -> Doc
printCol [RelVar]
vars Doc -> Doc -> Doc
$++$ [PrimitiveDomain] -> Doc
forall a. Pretty a => [a] -> Doc
printCol [PrimitiveDomain]
primD
     else if Bool -> Bool
not ([RelVar] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RelVar]
vars) then
            [RelVar] -> Doc
forall a. Pretty a => [a] -> Doc
printCol [RelVar]
vars
          else if Bool -> Bool
not ([PrimitiveDomain] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PrimitiveDomain]
primD) then
                 [PrimitiveDomain] -> Doc
forall a. Pretty a => [a] -> Doc
printCol [PrimitiveDomain]
primD
               else Doc
space)
    Doc -> Doc -> Doc
$++$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> Domain -> Doc
forall a. Pretty a => a -> Doc
pretty Domain
souD
    Doc -> Doc -> Doc
$++$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> Domain -> Doc
forall a. Pretty a => a -> Doc
pretty Domain
tarD
    Doc -> Doc -> Doc
$++$
    (case Maybe WhenWhere
whenC of
       Nothing -> case Maybe WhenWhere
whereC of
                    Nothing -> Doc
rbrace
                    Just whereCon :: WhenWhere
whereCon -> Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> String -> Doc
text "Where" Doc -> Doc -> Doc
<+> Doc
lbrace
                                      Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> WhenWhere -> Doc
forall a. Pretty a => a -> Doc
pretty WhenWhere
whereCon
                                      Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> Doc
rbrace Doc -> Doc -> Doc
$++$ Doc
rbrace
       Just whenCon :: WhenWhere
whenCon -> case Maybe WhenWhere
whereC of
                         Nothing -> Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> String -> Doc
text "When" Doc -> Doc -> Doc
<+> Doc
lbrace
                                      Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> WhenWhere -> Doc
forall a. Pretty a => a -> Doc
pretty WhenWhere
whenCon
                                      Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> Doc
rbrace
                                      Doc -> Doc -> Doc
$++$ Doc
rbrace
                         Just whereCon :: WhenWhere
whereCon -> Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> String -> Doc
text "When" Doc -> Doc -> Doc
<+> Doc
lbrace
                                            Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> WhenWhere -> Doc
forall a. Pretty a => a -> Doc
pretty WhenWhere
whenCon
                                            Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> Doc
rbrace
                                Doc -> Doc -> Doc
$++$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> String -> Doc
text "Where" Doc -> Doc -> Doc
<+> Doc
lbrace
                                    Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> WhenWhere -> Doc
forall a. Pretty a => a -> Doc
pretty WhenWhere
whereCon
                                    Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> Doc
rbrace
                                Doc -> Doc -> Doc
$++$ Doc
rbrace)

instance Show Relation where
  show :: Relation -> String
show m :: Relation
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Relation -> Doc
forall a. Pretty a => a -> Doc
pretty Relation
m


instance Pretty PrimitiveDomain where
  pretty :: PrimitiveDomain -> Doc
pretty (PrimitiveDomain nam :: String
nam typ :: String
typ) = String -> Doc
text "primitive domain" Doc -> Doc -> Doc
<+> String -> Doc
text String
nam
   Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
typ

instance Show PrimitiveDomain where
  show :: PrimitiveDomain -> String
show m :: PrimitiveDomain
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ PrimitiveDomain -> Doc
forall a. Pretty a => a -> Doc
pretty PrimitiveDomain
m


instance Pretty RelVar where
  pretty :: RelVar -> Doc
pretty (RelVar typ :: String
typ nam :: String
nam) = String -> Doc
text String
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
typ

instance Show RelVar where
  show :: RelVar -> String
show m :: RelVar
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ RelVar -> Doc
forall a. Pretty a => a -> Doc
pretty RelVar
m


instance Pretty Domain where
  pretty :: Domain -> Doc
pretty (Domain dom :: String
dom tem :: ObjectTemplate
tem) =
    String -> Doc
text "domain" Doc -> Doc -> Doc
<+> String -> Doc
text String
dom
    Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> ObjectTemplate -> Doc
forall a. Pretty a => a -> Doc
pretty ObjectTemplate
tem

instance Show Domain where
  show :: Domain -> String
show m :: Domain
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Domain -> Doc
forall a. Pretty a => a -> Doc
pretty Domain
m


instance Pretty ObjectTemplate where
  pretty :: ObjectTemplate -> Doc
pretty (ObjectTemplate var :: String
var met :: String
met typ :: String
typ temL :: [PropertyTemplate]
temL) =
    String -> Doc
text String
var Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text String
met Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
typ Doc -> Doc -> Doc
<+> Doc
lbrace
    Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> (PropertyTemplate -> Doc -> Doc)
-> Doc -> [PropertyTemplate] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) (Doc -> Doc -> Doc)
-> (PropertyTemplate -> Doc) -> PropertyTemplate -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PropertyTemplate -> Doc
forall a. Pretty a => a -> Doc
pretty) Doc
empty [PropertyTemplate]
temL
    Doc -> Doc -> Doc
$+$ Doc
rbrace

instance Show ObjectTemplate where
  show :: ObjectTemplate -> String
show m :: ObjectTemplate
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ ObjectTemplate -> Doc
forall a. Pretty a => a -> Doc
pretty ObjectTemplate
m


instance Pretty PropertyTemplate where
  pretty :: PropertyTemplate -> Doc
pretty (PropertyTemplate nam :: String
nam expr :: Maybe OCL
expr tem :: Maybe ObjectTemplate
tem) =
    String -> Doc
text String
nam Doc -> Doc -> Doc
<+> String -> Doc
text "="
    Doc -> Doc -> Doc
<+> (case Maybe OCL
expr of
           Nothing -> case Maybe ObjectTemplate
tem of
                        Nothing -> Doc
empty
                        Just t :: ObjectTemplate
t -> ObjectTemplate -> Doc
forall a. Pretty a => a -> Doc
pretty ObjectTemplate
t
           Just e :: OCL
e -> case Maybe ObjectTemplate
tem of
                        Nothing -> OCL -> Doc
forall a. Pretty a => a -> Doc
pretty OCL
e
                        Just t :: ObjectTemplate
t -> OCL -> Doc
forall a. Pretty a => a -> Doc
pretty OCL
e Doc -> Doc -> Doc
<+> ObjectTemplate -> Doc
forall a. Pretty a => a -> Doc
pretty ObjectTemplate
t
        )

instance Show PropertyTemplate where
  show :: PropertyTemplate -> String
show m :: PropertyTemplate
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ PropertyTemplate -> Doc
forall a. Pretty a => a -> Doc
pretty PropertyTemplate
m


instance Pretty WhenWhere where
  pretty :: WhenWhere -> Doc
pretty (WhenWhere inv :: [RelInvok]
inv ocl :: [OCL]
ocl)
       | [RelInvok] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RelInvok]
inv =
          if [OCL] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OCL]
ocl
          then Doc
space
          else Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> (OCL -> Doc -> Doc) -> Doc -> [OCL] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) (Doc -> Doc -> Doc) -> (OCL -> Doc) -> OCL -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OCL -> Doc
forall a. Pretty a => a -> Doc
pretty) Doc
empty [OCL]
ocl
       | [OCL] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OCL]
ocl = Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> (RelInvok -> Doc -> Doc) -> Doc -> [RelInvok] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) (Doc -> Doc -> Doc) -> (RelInvok -> Doc) -> RelInvok -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelInvok -> Doc
forall a. Pretty a => a -> Doc
pretty) Doc
empty [RelInvok]
inv
       | Bool
otherwise = Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> (RelInvok -> Doc -> Doc) -> Doc -> [RelInvok] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) (Doc -> Doc -> Doc) -> (RelInvok -> Doc) -> RelInvok -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelInvok -> Doc
forall a. Pretty a => a -> Doc
pretty) Doc
empty [RelInvok]
inv
              Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> (OCL -> Doc -> Doc) -> Doc -> [OCL] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) (Doc -> Doc -> Doc) -> (OCL -> Doc) -> OCL -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OCL -> Doc
forall a. Pretty a => a -> Doc
pretty) Doc
empty [OCL]
ocl

instance Show WhenWhere where
  show :: WhenWhere -> String
show m :: WhenWhere
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ WhenWhere -> Doc
forall a. Pretty a => a -> Doc
pretty WhenWhere
m


instance Pretty RelInvok where
  pretty :: RelInvok -> Doc
pretty (RelInvok nam :: String
nam par :: [String]
par) = String -> Doc
text String
nam Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
lparen Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (String -> Doc -> Doc) -> Doc -> [String] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
(<+>) (Doc -> Doc -> Doc) -> (String -> Doc) -> String -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
forall a. Pretty a => a -> Doc
pretty)
   Doc
empty [String]
par Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rparen

instance Show RelInvok where
  show :: RelInvok -> String
show m :: RelInvok
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ RelInvok -> Doc
forall a. Pretty a => a -> Doc
pretty RelInvok
m


-- Print Fake OCL expressions

instance Pretty OCL where
  pretty :: OCL -> Doc
pretty (Paren ex :: OCL
ex) = Doc
lparen Doc -> Doc -> Doc
<+> OCL -> Doc
forall a. Pretty a => a -> Doc
pretty OCL
ex Doc -> Doc -> Doc
<+> Doc
rparen
  pretty (StringExp strE :: STRING
strE) = STRING -> Doc
forall a. Pretty a => a -> Doc
pretty STRING
strE
  pretty (BExp e :: Bool
e) = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ if Bool
e then "TRUE" else "FALSE"
  pretty (NotB e :: OCL
e) = String -> Doc
text "NOT" Doc -> Doc -> Doc
<+> Doc
lparen Doc -> Doc -> Doc
<+> OCL -> Doc
forall a. Pretty a => a -> Doc
pretty OCL
e Doc -> Doc -> Doc
<+> Doc
rparen
  pretty (AndB lE :: OCL
lE rE :: OCL
rE) = Doc
lparen Doc -> Doc -> Doc
<+> OCL -> Doc
forall a. Pretty a => a -> Doc
pretty OCL
lE Doc -> Doc -> Doc
<+> Doc
rparen Doc -> Doc -> Doc
<+> String -> Doc
text "AND" Doc -> Doc -> Doc
<+>
   Doc
lparen Doc -> Doc -> Doc
<+> OCL -> Doc
forall a. Pretty a => a -> Doc
pretty OCL
rE Doc -> Doc -> Doc
<+> Doc
rparen
  pretty (OrB lE :: OCL
lE rE :: OCL
rE) = Doc
lparen Doc -> Doc -> Doc
<+> OCL -> Doc
forall a. Pretty a => a -> Doc
pretty OCL
lE Doc -> Doc -> Doc
<+> Doc
rparen Doc -> Doc -> Doc
<+> String -> Doc
text "OR" Doc -> Doc -> Doc
<+>
   Doc
lparen Doc -> Doc -> Doc
<+> OCL -> Doc
forall a. Pretty a => a -> Doc
pretty OCL
rE Doc -> Doc -> Doc
<+> Doc
rparen
  pretty (Equal lE :: STRING
lE rE :: STRING
rE) = Doc
lparen Doc -> Doc -> Doc
<+> STRING -> Doc
forall a. Pretty a => a -> Doc
pretty STRING
lE Doc -> Doc -> Doc
<+> Doc
rparen Doc -> Doc -> Doc
<+> String -> Doc
text "=" Doc -> Doc -> Doc
<+>
   Doc
lparen Doc -> Doc -> Doc
<+> STRING -> Doc
forall a. Pretty a => a -> Doc
pretty STRING
rE Doc -> Doc -> Doc
<+> Doc
rparen

instance Show OCL where
  show :: OCL -> String
show m :: OCL
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ OCL -> Doc
forall a. Pretty a => a -> Doc
pretty OCL
m


instance Pretty STRING where
  pretty :: STRING -> Doc
pretty (Str e :: String
e) = String -> Doc
text "'" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text "'"
  pretty (ConcatExp lE :: STRING
lE rE :: STRING
rE) = STRING -> Doc
forall a. Pretty a => a -> Doc
pretty STRING
lE Doc -> Doc -> Doc
<+> String -> Doc
text "+" Doc -> Doc -> Doc
<+> STRING -> Doc
forall a. Pretty a => a -> Doc
pretty STRING
rE
  pretty (VarExp varE :: String
varE) = String -> Doc
forall a. Pretty a => a -> Doc
pretty String
varE

instance Show STRING where
  show :: STRING -> String
show m :: STRING
m = Doc -> String
forall a. Show a => a -> String
show (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ STRING -> Doc
forall a. Pretty a => a -> Doc
pretty STRING
m