{- |
Module      :  ./CSMOF/Print.hs
Description :  pretty printing for CSMOF
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 CSMOF.Print where

import CSMOF.As

import Common.Doc
import Common.DocUtils


instance Pretty Metamodel where
  pretty :: Metamodel -> Doc
pretty (Metamodel nam :: String
nam ele :: [NamedElement]
ele mode :: [Model]
mode) =
    String -> Doc
text "metamodel" Doc -> Doc -> Doc
<+> String -> Doc
text String
nam Doc -> Doc -> Doc
<+> Doc
lbrace
    Doc -> Doc -> Doc
$++$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> (NamedElement -> Doc -> Doc) -> Doc -> [NamedElement] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($++$) (Doc -> Doc -> Doc)
-> (NamedElement -> Doc) -> NamedElement -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedElement -> Doc
forall a. Pretty a => a -> Doc
pretty) Doc
empty [NamedElement]
ele
    Doc -> Doc -> Doc
$+$ Doc
rbrace
    Doc -> Doc -> Doc
$++$ (Model -> Doc -> Doc) -> Doc -> [Model] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) (Doc -> Doc -> Doc) -> (Model -> Doc) -> Model -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Model -> Doc
forall a. Pretty a => a -> Doc
pretty) Doc
empty [Model]
mode

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


instance Pretty NamedElement where
  pretty :: NamedElement -> Doc
pretty (NamedElement _ _ nes :: TypeOrTypedElement
nes) = TypeOrTypedElement -> Doc
forall a. Pretty a => a -> Doc
pretty TypeOrTypedElement
nes

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


instance Pretty TypeOrTypedElement where
  pretty :: TypeOrTypedElement -> Doc
pretty (TType typ :: Type
typ) = Type -> Doc
forall a. Pretty a => a -> Doc
pretty Type
typ
  pretty (TTypedElement _) = Doc
empty   -- Do not show properties at top level but inside classes

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


instance Pretty Type where
  pretty :: Type -> Doc
pretty (Type _ sub :: DataTypeOrClass
sub) = DataTypeOrClass -> Doc
forall a. Pretty a => a -> Doc
pretty DataTypeOrClass
sub

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


instance Pretty DataTypeOrClass where
  pretty :: DataTypeOrClass -> Doc
pretty (DDataType dat :: Datatype
dat) = Datatype -> Doc
forall a. Pretty a => a -> Doc
pretty Datatype
dat
  pretty (DClass cla :: Class
cla) = Class -> Doc
forall a. Pretty a => a -> Doc
pretty Class
cla

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


instance Pretty Datatype where
  pretty :: Datatype -> Doc
pretty (Datatype sup :: Type
sup) =
      String -> Doc
text "datatype" Doc -> Doc -> Doc
<+> String -> Doc
text (NamedElement -> String
namedElementName (Type -> NamedElement
typeSuper Type
sup))

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


instance Pretty Class where
  pretty :: Class -> Doc
pretty (Class sup :: Type
sup isa :: Bool
isa supC :: [Class]
supC own :: [Property]
own) =
    String -> Doc
text (if Bool
isa then "abstract class" else "class")
    Doc -> Doc -> Doc
<+> String -> Doc
text (NamedElement -> String
namedElementName (Type -> NamedElement
typeSuper Type
sup))
    Doc -> Doc -> Doc
<+> (case [Class]
supC of
           [] -> Doc
lbrace
           _ : _ -> String -> Doc
text "extends"
                    Doc -> Doc -> Doc
<+> (Class -> Doc -> Doc) -> Doc -> [Class] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ( Doc -> Doc -> Doc
(<+>) (Doc -> Doc -> Doc) -> (Class -> Doc) -> Class -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc
text (String -> Doc) -> (Class -> String) -> Class -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedElement -> String
namedElementName (NamedElement -> String)
-> (Class -> NamedElement) -> Class -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> NamedElement
typeSuper (Type -> NamedElement) -> (Class -> Type) -> Class -> NamedElement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Class -> Type
classSuperType) Doc
empty [Class]
supC
                    Doc -> Doc -> Doc
<+> Doc
lbrace)
    Doc -> Doc -> Doc
$+$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> (Property -> Doc -> Doc) -> Doc -> [Property] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) (Doc -> Doc -> Doc) -> (Property -> Doc) -> Property -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Property -> Doc
forall a. Pretty a => a -> Doc
pretty) Doc
empty [Property]
own
    Doc -> Doc -> Doc
$+$ Doc
rbrace

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


instance Pretty TypedElement where
  pretty :: TypedElement -> Doc
pretty (TypedElement _ _ sub :: Property
sub) = Property -> Doc
forall a. Pretty a => a -> Doc
pretty Property
sub

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


instance Pretty Property where
  pretty :: Property -> Doc
pretty (Property sup :: TypedElement
sup mul :: MultiplicityElement
mul opp :: Maybe Property
opp _) =
    String -> Doc
text "property" Doc -> Doc -> Doc
<+> String -> Doc
text (NamedElement -> String
namedElementName (TypedElement -> NamedElement
typedElementSuper TypedElement
sup))
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> MultiplicityElement -> Doc
forall a. Pretty a => a -> Doc
pretty MultiplicityElement
mul
    Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text (NamedElement -> String
namedElementName (Type -> NamedElement
typeSuper (TypedElement -> Type
typedElementType TypedElement
sup)))
    Doc -> Doc -> Doc
<+> (case Maybe Property
opp of
           Just n :: Property
n -> String -> Doc
text "oppositeOf" Doc -> Doc -> Doc
<+> String -> Doc
text (NamedElement -> String
namedElementName (TypedElement -> NamedElement
typedElementSuper (Property -> TypedElement
propertySuper Property
n)))
           Nothing -> Doc
empty)

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


instance Pretty MultiplicityElement where
  pretty :: MultiplicityElement -> Doc
pretty (MultiplicityElement low :: Integer
low upp :: Integer
upp _) =
    Doc
lbrack Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Integer -> Doc
forall a. Pretty a => a -> Doc
pretty Integer
low Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (if Integer
upp Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== -1
        then String -> Doc
text "*"
        else Integer -> Doc
forall a. Pretty a => a -> Doc
pretty Integer
upp)
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rbrack

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


-- Model part of CSMOF


instance Pretty Model where
  pretty :: Model -> Doc
pretty (Model mon :: String
mon obj :: [Object]
obj lin :: [Link]
lin mode :: Metamodel
mode) =
    String -> Doc
text "model" Doc -> Doc -> Doc
<+> String -> Doc
text String
mon
    Doc -> Doc -> Doc
<+> String -> Doc
text "conformsTo" Doc -> Doc -> Doc
<+> String -> Doc
text (Metamodel -> String
metamodelName Metamodel
mode) Doc -> Doc -> Doc
<+> Doc
lbrace
    Doc -> Doc -> Doc
$++$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> (Object -> Doc -> Doc) -> Doc -> [Object] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) (Doc -> Doc -> Doc) -> (Object -> Doc) -> Object -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Doc
forall a. Pretty a => a -> Doc
pretty) Doc
empty [Object]
obj
    Doc -> Doc -> Doc
$++$ Doc
space Doc -> Doc -> Doc
<+> Doc
space Doc -> Doc -> Doc
<+> (Link -> Doc -> Doc) -> Doc -> [Link] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Doc -> Doc -> Doc
($+$) (Doc -> Doc -> Doc) -> (Link -> Doc) -> Link -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Link -> Doc
forall a. Pretty a => a -> Doc
pretty) Doc
empty [Link]
lin
    Doc -> Doc -> Doc
$+$ Doc
rbrace

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


instance Pretty Object where
  pretty :: Object -> Doc
pretty (Object on :: String
on ot :: Type
ot _) =
    String -> Doc
text "object " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
on
    Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> String -> Doc
text (NamedElement -> String
namedElementName (Type -> NamedElement
typeSuper Type
ot))

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


instance Pretty Link where
  pretty :: Link -> Doc
pretty (Link lt :: Property
lt sou :: Object
sou tar :: Object
tar _) =
    String -> Doc
text "link" Doc -> Doc -> Doc
<+> String -> Doc
text (NamedElement -> String
namedElementName (TypedElement -> NamedElement
typedElementSuper (Property -> TypedElement
propertySuper Property
lt)))
    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 (Object -> String
objectName Object
sou) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
comma Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (Object -> String
objectName Object
tar) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
rparen Doc -> Doc -> Doc
$+$ Doc
empty

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