Working multiple assignments,

Need to fix recursive types

RosettaParser.cabal

@@ -37,6 +37,7 @@ library
       Parser.Header
       Parser.Type
       PrettyPrinter.Enum
+      PrettyPrinter.Expression
       PrettyPrinter.Function
       PrettyPrinter.General
       PrettyPrinter.Header

src/Model/Type.hs

@@ -26,9 +26,13 @@ data Condition = MakeCondition {
     expressionExpression :: Expression
 } deriving (Show)
 
+instance Eq Condition where
+    (==) (MakeCondition _ ex) (MakeCondition _ ex2) = ex == ex2
+
 -- |The representation of an expression
 data Expression = Variable String
     | PathExpression Expression Expression
+    | Keyword String
     | Int String
     | Real String
     | Boolean String
@@ -47,12 +51,24 @@ data ExplicitExpression = ExplicitEmpty
     | ExplicitVariable {name :: String, returnCoercion :: Coercion}
     | Value {name :: String, returnCoercion :: Coercion}
     | ExplicitList [ExplicitExpression]
+    | ExplicitKeyword String
     | ExplicitParens ExplicitExpression
     | ExplicitPath {super :: ExplicitExpression, sub :: ExplicitExpression, returnCoercion :: Coercion}
     | ExplicitFunction {name :: String, args :: [(ExplicitExpression, Coercion)], returnCoercion :: Coercion}
     | ExplicitIfSimple {cond :: (ExplicitExpression, Coercion), block1 :: (ExplicitExpression, Coercion), returnCoercion :: Coercion}
     | ExplicitIfElse {cond :: (ExplicitExpression, Coercion), block1 :: (ExplicitExpression, Coercion), block2 :: (ExplicitExpression, Coercion), returnCoercion :: Coercion}
-    deriving (Show) 
+
+instance Show ExplicitExpression where
+    show (ExplicitVariable name coer) = show $ "Variable: " ++ name
+    show (Value name coer) = show $ "Value: " ++ name
+    show (ExplicitList lst) = concatMap show lst
+    show (ExplicitKeyword name) = show $ "Keyword: " ++ name
+    show (ExplicitParens name) = show $ "(" ++ show name ++ ")"
+    show (ExplicitPath super sub coer) = show $ "(->" ++ show super ++ " " ++ show sub ++ ")"
+    show (ExplicitFunction name args coer) = show $ name ++ "(" ++ concatMap show args ++ ")" 
+    show (ExplicitIfSimple cond block coer) = show $ "if" ++ show cond ++ " then " ++ show block
+    show (ExplicitIfElse cond block1 block2 coer) = show $ "if" ++ show cond ++ " then " ++ show block1 ++ " else " ++ show block2
+    show ExplicitEmpty = show "Empty"
 
 data TypeCoercion =
     MakeIdCoercion {toType :: Type}

src/Parser/Expression.hs

@@ -106,7 +106,9 @@ terminalParser :: Parser Expression
 terminalParser =
     do
         choice
-            [ prefixParser,
+            [  
+             try keywordParser,
+             prefixParser,
              parens expressionParser >>= \e -> return (Parens e),
              listParser,
              try booleanParser,
@@ -119,6 +121,14 @@ terminalParser =
 --------------------------------------------
 -- Expressions -----------------------------
 --------------------------------------------
+keywords :: [String]
+keywords = ["one-of"]
+
+keywordParser :: Parser Expression
+keywordParser = 
+    do 
+        word <- lexeme $ choice $ fmap (try . string . Text.pack) keywords
+        return $ Keyword $ Text.unpack word
 
 -- |Parses an prefix function statement in Rosetta into an Expression
 prefixParser :: Parser Expression

src/PrettyPrinter/Expression.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module PrettyPrinter.Expression where
+
+import Model.Type
+import Prettyprinter
+import Semantic.ExpressionChecker(coercionIncluded)
+
+printExpression :: ExplicitExpression -> Coercion -> Doc a
+printExpression ExplicitEmpty _ = "[]" 
+printExpression (ExplicitVariable name coer) out = case coer `coercionIncluded` out of 
+    Left err -> error $ show err
+    Right c -> printCoercion c $ pretty name
+printExpression (Value s coer) out = case coer `coercionIncluded` out of
+    Left err -> error $ show err 
+    Right c -> printCoercion c $ pretty s
+printExpression (ExplicitKeyword k) out = pretty k
+printExpression (ExplicitParens ex) out = "(" <> printExpression ex out <> ")"
+printExpression (ExplicitList ex) out = list [printExpression x out | x <- ex]
+printExpression (ExplicitPath ex1 ex2 returnCoerce) out = printCoercion (returnCoercion ex1) (printExpression ex1 (returnCoercion ex1)) <+> "->" <+> printCoercion (returnCoercion ex2) (printExpression ex2 out)
+printExpression (ExplicitFunction "exists" args returnCoerce) out = printCoercion returnCoerce "isJust" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
+printExpression (ExplicitFunction "is absent" args returnCoerce) out = printCoercion returnCoerce "isNothing" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
+printExpression (ExplicitFunction "single exists" args returnCoerce) out = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> "==" <+> "1"
+printExpression (ExplicitFunction "multiple exists" args returnCoerce) out = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> ">" <+> "1" 
+printExpression (ExplicitFunction "count" args returnCoerce) out = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
+-- Equality expressions
+-- [a] a all = 
+-- any <>
+printExpression (ExplicitFunction "=" args returnCoerce) out = printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> "==" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out)
+printExpression (ExplicitFunction "<>" args returnCoerce) out = printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> "/=" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out)
+printExpression (ExplicitFunction "any =" args returnCoerce) out = printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out) <+> "`elem`" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
+printExpression (ExplicitFunction "all <>" args returnCoerce) out = printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out) <+> "`notElem`" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
+printExpression (ExplicitFunction "all =" args returnCoerce) out = "all (Eq)" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out) <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
+printExpression (ExplicitFunction "and" args returnCoerce) out = printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> "&&" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out)
+printExpression (ExplicitFunction "or" args returnCoerce) out = printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> "||" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out)
+printExpression (ExplicitFunction name args returnCoerce) out = pretty name <+> tupled (zipWith printCoercion [c | (e,c) <- args] [printExpression e out | (e, c) <- args])
+printExpression (ExplicitIfSimple cond thenBlock returnCoercion) out = 
+    "if" <+> printCoercion (snd cond) (printExpression (fst cond) (MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1))))) <+> 
+    "then" <+> printCoercion (snd thenBlock) (printExpression (fst thenBlock) out) <+> 
+    "else" <+> case MakeCoercion [MakeIdCoercion $ coercionType $ typeCoercion returnCoercion] (MakeCardinalityIdCoercion (Bounds (0, 0))) `coercionIncluded` out of
+        Left err -> error $ show err
+        Right c -> printCoercion c emptyDoc
+printExpression (ExplicitIfElse cond thenBlock elseBlock returnCoercion) out = 
+    "if" <+> printCoercion (snd cond) (printExpression (fst cond) (MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1))))) <+> 
+    "then" <+> printCoercion (snd thenBlock) (printExpression (fst thenBlock) out) <+> 
+    "else" <+> printCoercion (snd elseBlock) (printExpression (fst elseBlock) out)
+
+-- |Converts a coercion into a haskell string
+printCoercion :: Coercion -> Doc a -> Doc a
+printCoercion (MakeCoercion [] crd) d = printCardinalityCoercion crd d
+printCoercion (MakeCoercion (t: ts) crd) d = printTypeCoercion t <> printCoercion (MakeCoercion ts crd) d
+
+printCardinalityCoercion :: CardinalityCoercion -> Doc a -> Doc a
+printCardinalityCoercion (MakeCardinalityIdCoercion _) d = d
+printCardinalityCoercion (MakeListCardinalityCoercion _ _) d = d
+printCardinalityCoercion (MakeNothing2MaybeCoercion _ _) d = "Nothing"
+printCardinalityCoercion (MakeNothing2ListCoercion _ _) d = "[]"
+printCardinalityCoercion (MakeMaybe2ListCoercion _ _) d = "maybeToList" <+> d
+printCardinalityCoercion (MakeObject2MaybeCoercion _ _) d = "Just" <+> d
+printCardinalityCoercion (MakeObject2ListCoercion _ _) d = "[" <> d <> "]"
+
+printTypeCoercion :: TypeCoercion -> Doc a
+printTypeCoercion (MakeIdCoercion _) = emptyDoc
+printTypeCoercion (MakeSuperCoercion _ _) = "super" <+> emptyDoc
+printTypeCoercion (MakeTypeCoercion _ _ t) = pretty t <+> emptyDoc
+
+-- |Converts a list of type attributes to a Doc with a list of variable names
+printVariableNames :: [TypeAttribute] -> Doc a
+printVariableNames vars = foldl (<+>) emptyDoc (map (pretty . attributeName) vars)

src/PrettyPrinter/Function.hs

@@ -3,13 +3,36 @@
 module PrettyPrinter.Function where
 
 import Prettyprinter
+import PrettyPrinter.Expression
 import Model.Function
 import PrettyPrinter.General
 import PrettyPrinter.Type
 import Model.Type
-import Semantic.ExpressionChecker(coercionIncluded)
+import Utils.Utils (uncapitalize)
-  
+
--- show printStatementTree 
+{-
+Consider all assignments as trees
+Root must always bee the same type (output type of the functions)
+Merge at every level, the nodes that have the same type
+    1   1   1               1                   1                   1
+    |   |   |             / | \               /   \               /   \
+    2   2   4    --->   2   2   4    --->   2       4    --->   2       4
+    |   |   |           |   |   |           | \     |           |       |
+    3   3   5    --->   3   3   5    --->   3   3   5    --->   3       5
+    |   |   |           |   |   |           |   |   |           | \     |
+    EX1 EX2 EX3         EX1 EX2 EX3         EX1 EX2 EX3         EX1 EX2 EX3
+-}
+
+data AssignmentTree = AssignmentNode {
+    var :: String,
+    typ :: Type,
+    children :: [AssignmentTree]
+    }
+    | AssignmentLeaf ExplicitExpression
+
+instance Show AssignmentTree where
+    show (AssignmentNode var typ child) = "Node: " ++ show (typeName typ) ++  show child
+    show (AssignmentLeaf exp) = "Leaf: " ++ show exp
 
 -- |Converts a Function into a haskell valid String
 printFunction :: ExplicitFunction -> String
@@ -17,69 +40,11 @@ printFunction f = show $ vcat [printFunctionSignature (sign f), printFunctionBod
 
 -- |Converts the body of a Function into a haskell valid Doc
 printFunctionBody :: ExplicitFunction -> Doc a
-printFunctionBody (MakeExplicitFunction (MakeFunctionSignature name _ inp out) ex) = pretty name <+> printVariableNames inp <+> "= where" 
+printFunctionBody (MakeExplicitFunction (MakeFunctionSignature name _ inp out) ex) =
-    <+> vcat [printExpression (fst exp) (returnCoercion (fst exp)) <+> " = " 
+    pretty name <+> printVariableNames inp <+> "=" <+> 
-        <+> printExpression (snd exp) (returnCoercion (fst exp)) |exp <- ex]
+    printAssignmentTree (head $ mergeAssignmentTrees [convertToAssignmentTree (fst exp) (AssignmentLeaf (snd exp)) | exp <- ex]) (returnCoercion (fst $ head ex))
-printExpression :: ExplicitExpression -> Coercion -> Doc a
+    --error $ show $ mergeAssignmentTrees [convertToAssignmentTree (fst exp) (AssignmentLeaf (snd exp)) | exp <- ex]
-printExpression ExplicitEmpty _ = "[]" 
-printExpression (ExplicitVariable name coer) out = case coer `coercionIncluded` out of 
-    Left err -> error $ show err
-    Right c -> printCoercion c $ pretty name
-printExpression (Value s coer) out = case coer `coercionIncluded` out of
-    Left err -> error $ show err 
-    Right c -> printCoercion c $ pretty s
-printExpression (ExplicitParens ex) out = "(" <> printExpression ex out <> ")"
-printExpression (ExplicitList ex) out = list [printExpression x out | x <- ex]
-printExpression (ExplicitPath ex1 ex2 returnCoerce) out = printCoercion (returnCoercion ex1) (printExpression ex1 (returnCoercion ex1)) <+> "->" <+> printCoercion (returnCoercion ex2) (printExpression ex2 out)
-printExpression (ExplicitFunction "exists" args returnCoerce) out = printCoercion returnCoerce "isJust" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
-printExpression (ExplicitFunction "is absent" args returnCoerce) out = printCoercion returnCoerce "isNothing" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
-printExpression (ExplicitFunction "single exists" args returnCoerce) out = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> "==" <+> "1"
-printExpression (ExplicitFunction "multiple exists" args returnCoerce) out = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> ">" <+> "1" 
-printExpression (ExplicitFunction "count" args returnCoerce) out = printCoercion returnCoerce "length" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
--- Equality expressions
--- [a] a all = 
--- any <>
-printExpression (ExplicitFunction "=" args returnCoerce) out = printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> "==" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out)
-printExpression (ExplicitFunction "<>" args returnCoerce) out = printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> "/=" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out)
-printExpression (ExplicitFunction "any =" args returnCoerce) out = printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out) <+> "`elem`" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
-printExpression (ExplicitFunction "all <>" args returnCoerce) out = printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out) <+> "`notElem`" <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
-printExpression (ExplicitFunction "all =" args returnCoerce) out = "all (Eq)" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out) <+> printCoercion (snd $ head args) (printExpression (fst $ head args) out)
-printExpression (ExplicitFunction "and" args returnCoerce) out = printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> "&&" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out)
-printExpression (ExplicitFunction "or" args returnCoerce) out = printCoercion (snd $ head args) (printExpression (fst $ head args) out) <+> "||" <+> printCoercion (snd $ head $ tail args) (printExpression (fst $ head $ tail args) out)
-printExpression (ExplicitFunction name args returnCoerce) out = pretty name <+> tupled (zipWith printCoercion [c | (e,c) <- args] [printExpression e out | (e, c) <- args])
-printExpression (ExplicitIfSimple cond thenBlock returnCoercion) out = 
-    "if" <+> printCoercion (snd cond) (printExpression (fst cond) (MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1))))) <+> 
-    "then" <+> printCoercion (snd thenBlock) (printExpression (fst thenBlock) out) <+> 
-    "else" <+> case MakeCoercion [MakeIdCoercion $ coercionType $ typeCoercion returnCoercion] (MakeCardinalityIdCoercion (Bounds (0, 0))) `coercionIncluded` out of
-        Left err -> error $ show err
-        Right c -> printCoercion c emptyDoc
-printExpression (ExplicitIfElse cond thenBlock elseBlock returnCoercion) out = 
-    "if" <+> printCoercion (snd cond) (printExpression (fst cond) (MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1))))) <+> 
-    "then" <+> printCoercion (snd thenBlock) (printExpression (fst thenBlock) out) <+> 
-    "else" <+> printCoercion (snd elseBlock) (printExpression (fst elseBlock) out)
 
--- |Converts a coercion into a haskell string
-printCoercion :: Coercion -> Doc a -> Doc a
-printCoercion (MakeCoercion [] crd) d = printCardinalityCoercion crd d
-printCoercion (MakeCoercion (t: ts) crd) d = printTypeCoercion t <> printCoercion (MakeCoercion ts crd) d
-
-printCardinalityCoercion :: CardinalityCoercion -> Doc a -> Doc a
-printCardinalityCoercion (MakeCardinalityIdCoercion _) d = d
-printCardinalityCoercion (MakeListCardinalityCoercion _ _) d = d
-printCardinalityCoercion (MakeNothing2MaybeCoercion _ _) d = "Nothing"
-printCardinalityCoercion (MakeNothing2ListCoercion _ _) d = "[]"
-printCardinalityCoercion (MakeMaybe2ListCoercion _ _) d = "maybeToList" <+> d
-printCardinalityCoercion (MakeObject2MaybeCoercion _ _) d = "Just" <+> d
-printCardinalityCoercion (MakeObject2ListCoercion _ _) d = "[" <> d <> "]"
-
-printTypeCoercion :: TypeCoercion -> Doc a
-printTypeCoercion (MakeIdCoercion _) = emptyDoc
-printTypeCoercion (MakeSuperCoercion _ _) = "super" <+> emptyDoc
-printTypeCoercion (MakeTypeCoercion _ _ t) = pretty t <+> emptyDoc
-
--- |Converts a list of type attributes to a Doc with a list of variable names
-printVariableNames :: [TypeAttribute] -> Doc a
-printVariableNames vars = foldl (<+>) emptyDoc (map (pretty . attributeName) vars)
 
 -- |Converts a function into a haskell valid Doc representing the signature of the function
 printFunctionSignature :: FunctionSignature -> Doc a
@@ -90,9 +55,40 @@ printFunctionSignature (MakeFunctionSignature name description inputs output) =
 prettyPrintType :: [Doc x] -> Doc x
 prettyPrintType = align . sep . Prelude.zipWith (<+>) ("::" : repeat "->")
 
--- |Gets the cardinality of a variable by name
+printAssignmentTree :: AssignmentTree -> Coercion -> Doc a
-getVarCardinality :: [TypeAttribute] -> String -> Cardinality
+printAssignmentTree (AssignmentLeaf exp) coer = printExpression exp coer
-getVarCardinality [] _ = error "Variable not a parameter" 
+printAssignmentTree (AssignmentNode var typ c) coer
-getVarCardinality (MakeTypeAttribute name _ card _ : inps) varName 
+    | length c == 1 = case head c of
-    | name == varName = card
+        AssignmentLeaf e -> printConstructor typ <+>  "(" <+> printAssignmentTree (head c) coer <> ")" 
-    | otherwise = getVarCardinality inps varName
+        AssignmentNode v t _ -> printConstructor typ <> printConstructor t <+> "(" <+> printAssignmentTree (head c) coer <> ")" 
+    | otherwise = case typ of
+        MakeType t _ _ _ _ -> "Make" <> pretty t <+> group (sep [printAssignmentTree child coer | child <- c])
+        BasicType _ -> sep [printAssignmentTree child coer | child <- c]
+
+mergeAssignmentTrees :: [AssignmentTree] -> [AssignmentTree]
+mergeAssignmentTrees [] = []
+mergeAssignmentTrees [a1] = [a1]
+mergeAssignmentTrees (a1: a2 : as)
+    | length merge == 1 = mergeAssignmentTrees [AssignmentNode {var = var a1, typ = typ a1, children = mergeAssignmentTrees (children (head merge))}] ++ as
+    | otherwise = mergeAssignmentTrees (a1 : as) ++ mergeAssignmentTrees (a2 : as)
+    where
+        merge = mergeAssignmentTree a1 a2
+
+mergeAssignmentTree :: AssignmentTree -> AssignmentTree -> [AssignmentTree]
+mergeAssignmentTree (AssignmentNode var1 typ1 c1) (AssignmentNode var2 typ2 c2)
+    | typ1 == typ2 && var1 == var2 = [AssignmentNode var1 typ1 (c1 ++ c2)]
+    | otherwise = [AssignmentNode var1 typ1 c1, AssignmentNode var2 typ2 c2]
+mergeAssignmentTree t1 t2 = [t1, t2]
+
+-- |Convert an assignment expression into an assignment tree
+convertToAssignmentTree :: ExplicitExpression -> AssignmentTree -> AssignmentTree
+convertToAssignmentTree (ExplicitVariable a c) t = AssignmentNode {var = a, typ = coercionType $ typeCoercion c, children = [t]}
+convertToAssignmentTree (ExplicitPath ex1 (ExplicitVariable a c) _) t =
+    convertToAssignmentTree ex1 (AssignmentNode {var = a, typ = coercionType $ typeCoercion c, children = [t]})
+convertToAssignmentTree e _ = error $ "Unsupported expression in path expression " ++ show e
+
+
+-- |Prints the type name if it is new type, or nothing for basic types
+printConstructor :: Type -> Doc a
+printConstructor (MakeType a _ _ _ _) = pretty a
+printConstructor (BasicType a) = emptyDoc

src/PrettyPrinter/Type.hs

@@ -10,20 +10,26 @@ import Utils.Utils
 -- |Converts an EnumType into a haskell valid String
 printType :: Type -> String
 printType (MakeType name (MakeType super _ _ _ _) description attributes conditions) = printType (MakeType name (BasicType "Object") description (superToAttribute super:attributes) conditions)
-printType (MakeType name (BasicType "Object") description attributes conditions) =
+printType (MakeType name (BasicType "Object") description attributes conditions) = 
-    show $ printDescription description (vcat [nest 4 $ vcat ("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": printAttributes name attributes ++ map printCondition conditions), "}", emptyDoc, emptyDoc])
+    show $ printTypeName name description <+>
+    printAttributes name conditions attributes
 printType (MakeType _ (BasicType _) _ _ _) = error "Can't extend basic types"
 printType (BasicType name) = show $ pretty name
    
+printTypeName :: String -> Maybe String -> Doc a
+printTypeName name desc = printDescription desc (line <> "data" <+> pretty name <+> "=") 
+
 -- |Creates an attribute that accesses the super type
 superToAttribute :: String -> TypeAttribute
 superToAttribute typ = MakeTypeAttribute "super" (MakeType typ (BasicType "Object") Nothing [] []) (Bounds (1, 1)) (Just "Pointer to super class")  
    
 -- |Converts a list of TypeAttributes into a list of haskell valid Docs 
-printAttributes :: String -> [TypeAttribute] -> [Doc a]
+printAttributes :: String -> [Condition] -> [TypeAttribute] -> Doc a
-printAttributes _ [] = []
+printAttributes objName conditions ats
-printAttributes objName [at] = [printAttribute objName at]
+    | MakeCondition Nothing (Keyword "one-of") `elem` conditions || length ats < 2 = vcat [nest 4 $ vcat $ 
-printAttributes objName (at : ats) = (printAttribute objName at <> ",") : printAttributes objName ats
+        zipWith (<>) ("" : repeat "| ") (map (printSumType objName) ats) ++ map printCondition conditions, emptyDoc, emptyDoc] 
+    | otherwise = vcat [nest 4 $ vcat ("Make" <> pretty objName <+> "{" : 
+        reverse (zipWith (<>) (reverse (map (printAttribute objName) ats)) ("" : repeat ",")) ++ map printCondition conditions), "}", emptyDoc, emptyDoc]
    
 -- |Converts a TypeAttribute into a haskell valid Doc
 printAttribute :: String -> TypeAttribute -> Doc a
@@ -40,4 +46,7 @@ printCardinality (MakeTypeAttribute _ typ (Bounds (x, y)) _)
 printCardinality (MakeTypeAttribute _ typ (OneBound _) _) = "[" <> pretty (typeName typ) <> "]"
 
 printCondition :: Condition -> Doc a
-printCondition (MakeCondition desc e) = printDescription desc ("--" <+> pretty (show e))
+printCondition (MakeCondition desc e) = printDescription desc ("--" <+> pretty (show e))
+
+printSumType :: String -> TypeAttribute -> Doc a
+printSumType objName (MakeTypeAttribute name typ crd _) = pretty objName <> pretty (capitalize name) <+> pretty (typeName typ)

src/Semantic/ExpressionChecker.hs

@@ -92,6 +92,7 @@ checkExpression _ (Int val) = Right $ Value val $ MakeCoercion [MakeIdCoercion (
 checkExpression _ (Real val) = Right $ Value val $ MakeCoercion [MakeIdCoercion (BasicType "Double")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
 checkExpression _ (Boolean val) = Right $ Value val $ MakeCoercion [MakeIdCoercion (BasicType "Boolean")] (MakeCardinalityIdCoercion (Bounds (1, 1)))
 checkExpression _ Empty = Right $ Value "empty" $ MakeCoercion [MakeIdCoercion (BasicType "Empty")] (MakeCardinalityIdCoercion (Bounds (0, 0)))
+checkExpression _ (Keyword k) = Right $ ExplicitKeyword k
 checkExpression symbolMap (PathExpression ex1 (Variable b)) =
     case checkExpression symbolMap ex1 of
         Left err -> Left err
@@ -100,13 +101,13 @@ checkExpression symbolMap (PathExpression ex1 (Variable b)) =
             Right exp2 -> Right $ ExplicitPath exp1 exp2 (returnCoercion exp2)
             where
                 type1 = coercionType $ typeCoercion $ returnCoercion exp1
+-- |Getting here means that an expression is used inside a path expression and this is not supported
+checkExpression _ (PathExpression _ ex) = Left $ UnsupportedExpressionInPathExpression $ show ex
 --checkExpression symbolMap (PathExpression ex1 (PathExpression ))
 checkExpression symbolMap (Parens ex) =
     case checkExpression symbolMap ex of
         Left err -> Left err
         Right exp -> Right $ ExplicitParens exp
--- |Getting here means that an expression is used inside a path expression and this is not supported
-checkExpression _ (PathExpression _ ex) = Left $ UnsupportedExpressionInPathExpression $ show ex
 checkExpression symbolMap (List lst) = checkList symbolMap lst
 checkExpression symbolMap (PrefixExp name ex) = checkFunctionCall symbolMap name [checkExpression symbolMap ex]
 checkExpression symbolMap (Function name exps) = checkFunctionCall symbolMap name (map (checkExpression symbolMap) exps)