Added haddock documentation

app/Main.hs

@@ -13,43 +13,53 @@ import PrettyPrinter.Function
 import Semantic.TypeChecker
 import Semantic.ExpressionChecker
 import Semantic.FunctionChecker
-import Model.Function
 import Model.Type
 import System.Environment.Blank (getArgs)
 import Model.Enum
 import Data.Either
 
 -- :set args resources/testAll.rosetta resources/Generated/testAll.hs
+-- |Reads a rosetta string from the first input argument and writes a haskell output to the file given as a second argument
 main :: IO ()
 main = do
     args <- getArgs
     rosettaString <- readFile $ head args
+    -- |Parse the string read from the input file
     case parse rosettaParser "" (Text.pack rosettaString) of
         Left errorBundle -> print (errorBundlePretty errorBundle)
         Right objs -> do
+            -- |Write the haskell string into the second argument
             writeFile (args !! 1) (printObjects (definedTypes, definedFunctions) objs) 
             where 
+                -- |Adds all the function definitions from the file into the symbol table
                 definedFunctions = addNewFunctions (definedTypes, defaultMap) objs
+                -- |Adds all the new data types into the symbol table 
                 definedTypes = addNewTypes [] objs
-      
+   
+-- |Reads a rosetta string from the first input argument, parses that string and then writes a haskell output to the file given as a second argument   
 printObjects :: ([Type], [Symbol]) -> [RosettaObject] -> String
 printObjects (t, s) objs
     | null (lefts finalString) = concat $ rights finalString
     | otherwise = error $ show $ lefts finalString
     where finalString = map (printObject (t, s)) objs  
-                    
+          
+-- |Checks the RosettaObject for type errors and then converts it into a haskell string         
 printObject :: ([Type], [Symbol]) -> RosettaObject -> Either [TypeCheckError] String
+-- |Checks the type and attributes of a type and then converts it
 printObject (definedTypes, _) (TypeObject t)
     | isRight checked = Right $ printType $ fromRightUnsafe checked
     | otherwise = Left $ fromLeftUnsafe checked
     where checked = checkType definedTypes t
+-- |Enum is converted directly since no type checks are necessary
 printObject _ (EnumObject e) = Right $ printEnum e
+-- |Checks the function inputs, output and assignment and converts it
 printObject (definedTypes, definedFunctions) (FunctionObject fun)
     | isRight checked = Right $ printFunction $ fromRightUnsafe checked
     | otherwise = Left $ fromLeftUnsafe checked
     where 
         checked = checkFunction (definedTypes, definedFunctions) fun
 
+-- |Adds new defined functions into the symbol table
 addNewFunctions :: ([Type], [Symbol]) -> [RosettaObject] -> [Symbol]
 addNewFunctions (_, s) [] = s
 addNewFunctions (t, s) ((FunctionObject f):os)
@@ -58,65 +68,28 @@ addNewFunctions (t, s) ((FunctionObject f):os)
     where definedFunctions = addFunction (t, addNewFunctions (t, s) os) f
 addNewFunctions (t, s) (_:os) = addNewFunctions (t, s) os
 
+-- |Adds new defined types into the symbol table
 addNewTypes :: [Type] -> [RosettaObject] -> [Type]
 addNewTypes l [] = l
 addNewTypes defined (TypeObject o: os) = addDefinedTypes (addNewTypes defined os) [o] 
 addNewTypes defined (EnumObject (MakeEnum name _ _): os) = addDefinedTypes (addNewTypes defined os) [MakeType name Nothing Nothing []]
 addNewTypes defined (_ :os) = addNewTypes defined os
 
+-- |Parses any supported Rosetta types into a list of RosettaObject
 rosettaParser :: Parser [RosettaObject]
 rosettaParser = many (try parseEnum <|> try parseType <|> try parseFunction) <* eof
 
+-- |Reads an enum into a RosettaObject
 parseEnum :: Parser RosettaObject
 parseEnum = do
     EnumObject <$> enumParser
     
+-- |Parse a type into a RosettaObject
 parseType :: Parser RosettaObject
 parseType = do
     TypeObject <$> typeParser
     
+-- |Parse a function into a RosettaObject
 parseFunction :: Parser RosettaObject
 parseFunction = do
-    FunctionObject <$> functionParser
+    FunctionObject <$> functionParser
-
-testEnum :: IO()
-testEnum = do
-    rosettaString <- readFile "resources/Enums/testEnum1.rosetta"
-    case parse enumParser "" (Text.pack rosettaString) of
-        Left errorBundle -> print errorBundle
-        Right enum -> 
-            do
-                putStrLn $ printEnum enum
-                writeFile "resources/Generated/generatedEnum.hs" (printEnum enum) 
-        
-testTypeParser :: IO()
-testTypeParser = do
-    rosettaString <- readFile "resources/Types/testType1.rosetta"
-    case parse typeParser "" (Text.pack rosettaString) of
-        Left errorBundle -> print (errorBundlePretty errorBundle)
-        Right typ -> 
-            do
-                putStrLn $ printType typ
-                print typ
-                writeFile "resources/Generated/generatedType.hs" (printType typ) 
-              
-testTypeChecker :: IO ()
-testTypeChecker = do
-    rosettaString <- readFile "src/TestFiles/testType.rosetta"
-    case parse (many typeParser) "" (Text.pack rosettaString) of
-        Left errorBundle -> print (errorBundlePretty errorBundle)
-        Right typ -> 
-            do
-                print $ map (checkAttributes definedTypes . typeAttributes) typ
-                where definedTypes = addDefinedTypes [] typ
-                
-testFunc :: IO()
-testFunc = do
-    rosettaString <- readFile "resources/testFunction.rosetta"
-    case parse functionParser "" (Text.pack rosettaString) of
-        Left errorBundle -> print (errorBundlePretty errorBundle)
-        Right fun -> 
-            do
-                print $ printFunctionSignature fun
-                print (assignment fun)
-                writeFile "resources/Generated/generatedFunction.hs" (show $ printFunctionSignature fun) 

src/Model/Enum.hs

@@ -1,11 +1,13 @@
 module Model.Enum where
 
+-- |The representation of a Rosetta enum data type
 data EnumType = MakeEnum {
     enumName :: String,
     enumDescription :: Maybe String,
     enumValues :: [EnumValue]
 } deriving (Show, Eq)
 
+-- |The representation of a Rosetta enum value type
 data EnumValue = MakeEnumValue {
     enumValueName :: String,
     enumValueDescription :: Maybe String,

src/Model/Function.hs

@@ -2,6 +2,7 @@ module Model.Function where
 
 import Model.Type (TypeAttribute)
   
+-- |The representation of a Rosetta function type
 data Function = 
     MakeFunction {
         functionName :: String,
@@ -11,18 +12,8 @@ data Function =
         assignment :: Expression
     }
     deriving (Show)
-    
---data Condition =
---    MakeCondition {
---        conditionDescription :: Maybe String,
---        conditionStatement :: Expression
---    }
---    | MakePostCondition {
---        conditionDescription :: Maybe String,
---        conditionStatement :: Expression
---    }
---    deriving (Show)
      
+-- |The representation of an expression
 data Expression = Variable String
     | Int String
     | Real String

src/Model/RosettaObject.hs

@@ -4,6 +4,7 @@ import Model.Enum
 import Model.Function
 import Model.Type
   
+-- |Any supported Rosetta object
 data RosettaObject = 
     EnumObject EnumType
     | TypeObject Type

src/Model/Type.hs

@@ -2,6 +2,7 @@ module Model.Type where
 
 import Data.Time.LocalTime()
 
+-- |The representation of a Rosetta data type
 data Type = MakeType {
         typeName :: String,
         superType :: Maybe Type,
@@ -22,6 +23,8 @@ instance Eq Type where
         | otherwise = False
     (==) _ _ = False
 
+
+-- |The representation of an attribute of a data type
 data TypeAttribute = MakeTypeAttribute {
     attributeName :: String,
     attributeType :: Type,
@@ -29,7 +32,12 @@ data TypeAttribute = MakeTypeAttribute {
     attributeDescription :: Maybe String
 } deriving (Show)
 
-data Cardinality = Bounds (Integer, Integer)
+-- |The representation of cardinality
+data Cardinality = 
+    -- |The cardinality between two bounds (ex. 2 - 5)
+  Bounds (Integer, Integer)
+    -- |The cardinality starting from one bound until infinity (ex. 5 - *)
   | OneBound Integer
+    -- |The cardinality of no bounds (ex. * - *)
   | NoBounds 
   deriving Show

src/Parser/Enum.hs

@@ -7,6 +7,8 @@ import Text.Megaparsec.Char
 import Text.Megaparsec
 import Model.Enum
 
+
+-- |Parses a complete Rosetta enum into a EnumType
 enumParser :: Parser EnumType
 enumParser = 
     do 
@@ -15,6 +17,8 @@ enumParser =
         values <- some enumValueParser
         return (MakeEnum eName eDescription values)
     
+    
+-- |Parses a Rosetta enum value into a EnumValue
 enumValueParser :: Parser EnumValue
 enumValueParser = 
     do
@@ -23,6 +27,8 @@ enumValueParser =
         vDescription <- optional descriptionParser
         return (MakeEnumValue vName vDescription dName)
 
+
+-- |Parses the display name of a Rosetta enum value into a String
 enumValueDisplayNameParser :: Parser String
 enumValueDisplayNameParser =
     do
@@ -30,6 +36,8 @@ enumValueDisplayNameParser =
         _ <- char '"'
         lexeme $ anySingle `manyTill` char '"'
 
+
+-- |Parses the name of a Rosetta enum into a String
 enumNameParser :: Parser String
 enumNameParser = 
     do

src/Parser/Expression.hs

@@ -8,6 +8,8 @@ import qualified Data.Text as Text
 import Text.Megaparsec
 import Text.Megaparsec.Char
 
+
+-- |Parses a complete Rosetta expression into an Expression type
 expressionParser :: Parser Expression
 expressionParser = 
     choice [ ifParser,
@@ -18,6 +20,7 @@ expressionParser =
 -- Command Structures ----------------------
 --------------------------------------------
 
+-- |Parses a function call in Rosetta into an Expression
 functionCallParser :: Parser Expression
 functionCallParser =
     do
@@ -30,6 +33,7 @@ functionCallParser =
             Nothing -> return $ Function f []
             Just at -> return $ Function f (ats ++ [at])
 
+-- |Parses an if statement in Rosetta into an Expression
 ifParser :: Parser Expression
 ifParser =
     do
@@ -42,6 +46,7 @@ ifParser =
             Left _ -> return (IfSimple condition expr)
             Right _ -> expressionParser >>= \expr2 -> return (IfElse condition expr expr2)
     
+-- |Parses an expression between parentheses in Rosetta into an Expression
 parens :: Parser a -> Parser a
 parens = between (char '(') (char ')')
 
@@ -49,6 +54,7 @@ parens = between (char '(') (char ')')
 -- Terminals -------------------------------
 --------------------------------------------
 
+-- |Parses a list in Rosetta into an Expression
 listParser :: Parser Expression
 listParser =
     do
@@ -58,6 +64,7 @@ listParser =
         _ <- lexeme $ char ']'
         return $ List (expressions ++ [lastExpr])
 
+-- |Parses a variable in Rosetta into an Expression
 variableParser :: Parser Expression
 variableParser =
     do
@@ -65,18 +72,21 @@ variableParser =
         inner <- many innerVariableParser
         return $ Variable (var ++ concatMap ("->" ++) inner)
 
+-- |Parses an inner variable (a -> b) in Rosetta into an Expression
 innerVariableParser :: Parser String
 innerVariableParser =
     do
         _ <- lexeme $ string "->"
         camelNameParser
 
+-- |Parses an integer in Rosetta into an Expression
 integerParser :: Parser Expression
 integerParser =
     do
         nr <- lexeme $ some digitChar
         return $ Int nr
-        
+    
+-- |Parses a real number in Rosetta into an Expression    
 decimalParser :: Parser Expression
 decimalParser =
     do
@@ -84,19 +94,22 @@ decimalParser =
         _ <- char '.'
         real <- lexeme $ many digitChar
         return $ Real $ nr ++ "." ++ real
-        
+      
+-- |Parses a boolean in Rosetta into an Expression  
 booleanParser :: Parser Expression
 booleanParser =
     do
         bol <- lexeme (string "True" <|> string "False")
         return $ Boolean $ Text.unpack bol
 
+-- |Parses the empty statement in Rosetta into an Expression
 emptyParser :: Parser Expression
 emptyParser = 
     do
         _ <- lexeme $ string "empty"
         return Empty
 
+-- |Parses any of the terminal statements in Rosetta into an Expression
 terminalParser :: Parser Expression
 terminalParser =
     do
@@ -115,12 +128,18 @@ terminalParser =
 -- Expressions -----------------------------
 --------------------------------------------
 
+-- |Parses an prefix function statement in Rosetta into an Expression
 prefixParser :: Parser Expression
 prefixParser = 
     do
         op <- lexeme $ choice $ fmap (try . string . Text.pack) prefixOperators
         PrefixExp (Text.unpack op) <$> expressionParser
+        
+-- |List of prefix operators
+prefixOperators :: [String]
+prefixOperators = ["-", "not"]
 
+-- |Parses an equality statement in Rosetta into an Expression
 eqParser :: Parser Expression
 eqParser =
     do
@@ -130,9 +149,11 @@ eqParser =
             Left _ -> return s
             Right o -> eqParser >>= \ex -> return $ InfixExp (Text.unpack o) s ex
 
+-- |The list of equality statements in Rosetta
 eqFunctions :: [String]
 eqFunctions = ["=", "<", "<=", ">", ">=", "<>", "all =", "all <>", "any =", "any <>"]
 
+-- |Parses a sum statement in Rosetta into an Expression
 sumParser :: Parser Expression
 sumParser =
     do
@@ -142,6 +163,7 @@ sumParser =
             Left _ -> return f
             Right o -> sumParser >>= \ex -> return $ reverseExpression $ InfixExp [o] f ex
 
+-- |Parses a multiplication or division statement in Rosetta into an Expression
 factorParser :: Parser Expression
 factorParser = 
     do 
@@ -151,6 +173,7 @@ factorParser =
             Left _ -> return p
             Right o -> factorParser >>= \ex -> return $ reverseExpression $ InfixExp [o] p ex
 
+-- |Parses a boolean statement in Rosetta into an Expression
 boolOpParser :: Parser Expression
 boolOpParser = 
     do 
@@ -160,6 +183,7 @@ boolOpParser =
             Left _ -> return p
             Right o -> boolOpParser >>= \ex -> return $ InfixExp (Text.unpack o) p ex
 
+-- |Parses a power statement in Rosetta into an Expression
 powerParser :: Parser Expression
 powerParser = 
     do
@@ -168,7 +192,8 @@ powerParser =
         case op of
             Left _ -> return p
             Right _ -> powerParser >>= \ex -> return $ InfixExp "^" p ex
-            
+     
+-- |Parses a postfix function in Rosetta into an Expression       
 postfixParser :: Parser Expression
 postfixParser = 
     do
@@ -178,6 +203,7 @@ postfixParser =
             Left _ -> return t
             Right o -> return $ PostfixExp (Text.unpack o) t
 
+-- |The list of existing postfix Rosetta functions
 postfixFunctions :: [String]
 postfixFunctions = ["exists", "is absent", "count", "only-element", "single exists", "multiple exists"]
 
@@ -185,12 +211,15 @@ postfixFunctions = ["exists", "is absent", "count", "only-element", "single exis
 -- Auxiliary  ------------------------------
 --------------------------------------------
 
+-- |Reverses the order of operations for left-associative functions
 reverseExpression :: Expression -> Expression
 reverseExpression (InfixExp op t1 (InfixExp op2 t2 e))
     | precedence op == precedence op2 = InfixExp op2 (reverseExpression (InfixExp op t1 t2)) e
     | otherwise = InfixExp op t1 (InfixExp op2 t2 e)
 reverseExpression e = e
 
+
+-- |The precedence of existing infix functions (higher goes first)
 precedence :: String -> Int
 precedence "or" = 1
 precedence "and" = 10
@@ -199,7 +228,4 @@ precedence "-" = 2
 precedence "*" = 3
 precedence "/" = 3
 precedence "^" = 4
-precedence _ = 100
+precedence _ = 100
-
-prefixOperators :: [String]
-prefixOperators = ["-", "not"]

src/Parser/Function.hs

@@ -10,6 +10,7 @@ import Text.Megaparsec
 import Text.Megaparsec.Char
 import Parser.General
   
+-- |Parses a function statement in Rosetta into a Function
 functionParser :: Parser Function
 functionParser =
     do
@@ -21,6 +22,7 @@ functionParser =
         fOutput <- outputAttributeParser
         MakeFunction fName fDescription fInput fOutput <$> assignmentParser
 
+-- |Parses the output assignment statement from a function in Rosetta into an Expression
 assignmentParser :: Parser Expression
 assignmentParser =
     do
@@ -28,18 +30,21 @@ assignmentParser =
         _ <- lexeme $ char ':'
         expressionParser
 
+-- |Parses the input attributes from a function statement in Rosetta into a list of TypeAttributes
 inputAttributesParser :: Parser [TypeAttribute]
 inputAttributesParser =
     do
         _ <- lexeme $ string "inputs:"
         many $ try attributeParser
 
+-- |Parses the output attribute of a function statement in Rosetta into a TypeAttribute
 outputAttributeParser :: Parser TypeAttribute
 outputAttributeParser =
     do
         _ <- lexeme $ string "output:"
         attributeParser
         
+-- |Auxiliary function that parses an attribute into a TypeAttribute
 attributeParser :: Parser TypeAttribute
 attributeParser =
     do

src/Parser/General.hs

@@ -10,19 +10,22 @@ import Data.Text
 
 type Parser = Parsec Void Text
 
+-- |Auxiliary parser that eliminates trailing white space
 spaceConsumer :: Parser ()
 spaceConsumer = L.space space1 (L.skipLineComment "//") (L.skipBlockComment "/*" "*/")
 
+-- |Auxiliary parser that runs a parser and eliminates trailing white space 
 lexeme :: Parser a -> Parser a
 lexeme = L.lexeme spaceConsumer
 
+-- |Parses a description in Rosetta into a String
 descriptionParser :: Parser String
 descriptionParser = 
     do
         _ <- string "<\""
         lexeme $ anySingle `manyTill` string "\">"
         
-
+-- |Parses a pascal case name into a String (PascalCase)
 pascalNameParser :: Parser String
 pascalNameParser =
     do
@@ -30,6 +33,7 @@ pascalNameParser =
         rest <- lexeme $ many allowedChars
         if first:rest `notElem` restrictedNames then return (first:rest) else fail ((first:rest) ++ " is a restricted name")
 
+-- |Parses a camel case name into a String (camelCase)
 camelNameParser :: Parser String
 camelNameParser =
     do
@@ -37,6 +41,7 @@ camelNameParser =
         rest <- lexeme $ many allowedChars
         if first:rest `notElem` restrictedNames then return (first:rest) else fail ((first:rest) ++ " is a restricted name")
 
+-- |Parses any name that starts with a letter or '_' into a String
 nameParser :: Parser String
 nameParser = 
     do 
@@ -44,9 +49,12 @@ nameParser =
         rest <- lexeme $ many allowedChars
         if first:rest `notElem` restrictedNames then return (first:rest) else fail ((first:rest) ++ " is a restricted name")
 
+-- |Parses a character allowed in names in Rosetta into a Char  
 allowedChars :: Parser Char
 allowedChars = letterChar <|> digitChar <|> char '_'
         
+        
+-- |List of restricted names used by Rosetta
 restrictedNames :: [String]
 restrictedNames = [
     "displayName",

src/Parser/Type.hs

@@ -7,6 +7,7 @@ import Text.Megaparsec.Char
 import Text.Megaparsec
 import Parser.General 
   
+-- |Parses a type declaration statement in Rosetta into an Type
 typeParser :: Parser Type
 typeParser = 
     do 
@@ -17,6 +18,7 @@ typeParser =
         tAttributes <- many $ try typeAttributeParser
         return (MakeType tName tSuper tDescription tAttributes)
 
+-- |Parses the super class declaration statement in Rosetta into an Type
 superTypeParser :: Parser Type
 superTypeParser =
     do
@@ -24,6 +26,7 @@ superTypeParser =
         name <- pascalNameParser 
         return $ MakeType name Nothing Nothing []
 
+-- |Parses a declared type attribute in Rosetta into a TypeAttribute
 typeAttributeParser :: Parser TypeAttribute
 typeAttributeParser = 
     do
@@ -33,11 +36,13 @@ typeAttributeParser =
         desc <- optional descriptionParser
         return (MakeTypeAttribute aName (MakeType aType Nothing Nothing []) card desc)
 
+-- |Parses the cardinality of a type attribute in Rosetta into a Cardinality
 cardinalityParser :: Parser Cardinality
 cardinalityParser =
     do
         try parseBounded <|> try parseSemiBounded <|> try parseUnbounded
 
+-- |Parses a bounded cardinality statement in Rosetta into a Cardinality
 parseBounded :: Parser Cardinality
 parseBounded = 
     do
@@ -48,7 +53,7 @@ parseBounded =
         _ <- lexeme $ char ')'
         return $ Bounds (read low, read up)
 
-
+-- |Parses a one bounded cardinality statement in Rosetta into a Cardinality
 parseSemiBounded :: Parser Cardinality
 parseSemiBounded = 
     do
@@ -57,13 +62,14 @@ parseSemiBounded =
         _ <- lexeme $ string "..*)"
         return $ OneBound $ read low
         
-        
+-- |Parses an unbounded cardinality statement in Rosetta into a Cardinality
 parseUnbounded :: Parser Cardinality
 parseUnbounded = 
     do
         _ <- lexeme $ string "(*..*)"
         return NoBounds
 
+-- |Parses the name of a type in Rosetta into a String
 typeNameParser :: Parser String
 typeNameParser = 
     do

src/PrettyPrinter/Enum.hs

@@ -6,6 +6,7 @@ import Model.Enum
 import PrettyPrinter.General
 import Prettyprinter
     
+-- |Converts an EnumType into a haskell valid String
 printEnum :: EnumType -> String
 printEnum (MakeEnum name description values) =
     show $ printDescription description 
@@ -14,22 +15,27 @@ printEnum (MakeEnum name description values) =
         "",
         printDisplayNames name values])
     
+-- |Converts a list of EnumValues into a haskell valid Doc
 printEnumValues :: [EnumValue] -> Doc a
 printEnumValues [] = ""
 printEnumValues (x:xs) = vcat (printFirstEnumValue x: map printEnumValue xs)
 
+-- |Converts the first EnumValue (in haskell without the '|') into a haskell valid Doc
 printFirstEnumValue :: EnumValue -> Doc a
 printFirstEnumValue (MakeEnumValue name description _) =
     printDescription description (pretty name)
 
+-- |Converts a non-first EnumValue (in haskell with the '|') into a haskell valid Doc
 printEnumValue :: EnumValue -> Doc a
 printEnumValue (MakeEnumValue name description _) = 
     printDescription description ("|" <+> pretty name)
         
+-- |Converts the display names of an EnumType into a haskell valid Doc
 printDisplayNames :: String -> [EnumValue] -> Doc a
 printDisplayNames name values = 
     nest 4 $ vcat ("instance Show" <+> pretty name <+> "where": map printDisplayName values)
         
+-- |Converts a single display name into a haskell valid Doc
 printDisplayName :: EnumValue -> Doc a
 printDisplayName (MakeEnumValue name _ (Just display)) =
     "show" <+> pretty name <+> "= \"" <> pretty display <> "\"" 

src/PrettyPrinter/Function.hs

@@ -9,9 +9,11 @@ import PrettyPrinter.Type
   
 -- show printStatementTree 
 
+-- |Converts a Function into a haskell valid String
 printFunction :: Function -> String
 printFunction f = show $ vcat [printFunctionSignature f, printFunctionBody f]
 
+-- |Converts the body of a Function into a haskell valid Doc
 printFunctionBody :: Function -> Doc a
 printFunctionBody (MakeFunction name _ _ _ ex) = pretty name <+> "=" <+> printExpression ex
 printExpression :: Expression -> Doc a
@@ -29,9 +31,11 @@ printExpression (InfixExp name ex1 ex2) = printExpression ex1 <+> pretty name <+
 printExpression (IfSimple cond ex) = "if" <+> printExpression cond <+> "then" <+> printExpression ex <+> "else" <+> "pure ()"
 printExpression (IfElse cond ex1 ex2) = "if" <+> printExpression cond <+> "then" <+> printExpression ex1 <+> "else" <+> printExpression ex2
 
+-- |Converts a function into a haskell valid Doc representing the signature of the function
 printFunctionSignature :: Function -> Doc a
 printFunctionSignature (MakeFunction name description inputs output _) =
     printDescription description (pretty name <+> prettyPrintType (Prelude.map printCardinality (inputs ++ [output])))
 
+-- |Zips the signature with the needed characters ('::', '->')
 prettyPrintType :: [Doc x] -> Doc x
 prettyPrintType = align . sep . Prelude.zipWith (<+>) ("::" : repeat "->")

src/PrettyPrinter/General.hs

@@ -4,6 +4,7 @@ module PrettyPrinter.General where
 
 import Prettyprinter
     
+-- |Converts a description String into a haskell valid Doc
 printDescription :: Maybe String -> Doc a -> Doc a
 printDescription (Just description) doc = 
     vcat [enclose "{-" "-}" (pretty description), doc]

src/PrettyPrinter/RosettaObject.hs

@@ -5,6 +5,7 @@ import PrettyPrinter.Enum
 import PrettyPrinter.Function
 import PrettyPrinter.Type
   
+-- |Converts a supported Rosetta object into a haskell valid String
 printRosettaObject :: RosettaObject -> String
 printRosettaObject (EnumObject a) = printEnum a
 printRosettaObject (TypeObject a) = printType a

src/PrettyPrinter/Type.hs

@@ -6,6 +6,7 @@ import Prettyprinter
 import PrettyPrinter.General
 import Model.Type
 
+-- |Converts an EnumType into a haskell valid String
 printType :: Type -> String
 printType (MakeType name (Just (MakeType super _ _ _)) description attributes) = printType (MakeType name Nothing description (superToAttribute super:attributes))
 printType (MakeType _ (Just (BasicType _)) _ _) = error "Can't extend basic types"
@@ -13,24 +14,23 @@ printType (MakeType name Nothing description attributes) =
     show $ printDescription description (vcat [nest 4 $ vcat ("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": printAttributes attributes), "}", ""])
 printType (BasicType name) = show $ pretty name
    
---printSuperType :: Maybe Type -> Doc a
+-- |Creates an attribute that accesses the super type
---printSuperType (Just (MakeType name _ _ _)) = "super" <+> "::" <+> pretty name
---printSuperType (Just (BasicType _)) = error "Can't extend basic types"
---printSuperType Nothing = emptyDoc
-   
 superToAttribute :: String -> TypeAttribute
 superToAttribute name = MakeTypeAttribute "super" (MakeType name Nothing Nothing []) (Bounds (1, 1)) (Just "Pointer to super class")  
    
+-- |Converts a list of TypeAttributes into a list of haskell valid Docs 
 printAttributes :: [TypeAttribute] -> [Doc a]
 printAttributes [] = []
 printAttributes [at] = [printAttribute at]
 printAttributes (at : ats) = (printAttribute at <> ",") : printAttributes ats
    
+-- |Converts a TypeAttribute into a haskell valid Doc
 printAttribute :: TypeAttribute -> Doc a
 printAttribute (MakeTypeAttribute name typ crd description) =
     printDescription description 
         (pretty name <+> "::" <+> printCardinality (MakeTypeAttribute name typ crd description))   
 
+-- |Converts a Cardinality into a haskell valid Doc
 printCardinality :: TypeAttribute -> Doc a
 printCardinality (MakeTypeAttribute _ typ (Bounds (x, y)) _)
     | x == 0 && y == 1 = "Maybe" <+> pretty (typeName typ)

src/Semantic/ExpressionChecker.hs

@@ -6,6 +6,7 @@ import Data.Maybe
 import Model.Type
 import Semantic.TypeChecker
   
+-- |A declared variable or function
 data Symbol = Var{
    varName :: String,
    declaredType :: Type
@@ -16,6 +17,7 @@ data Symbol = Var{
    returnType :: Type
    }
   
+-- |A map of the predefined functions, their arguments and their return type
 defaultMap :: [Symbol]
 defaultMap = [
   Func "or" [BasicType "Boolean", BasicType "Boolean"] (BasicType "Boolean"),
@@ -52,6 +54,7 @@ defaultMap = [
   Func "count" [BasicType "Any"] (BasicType "Integer")
   ]
 
+-- |Checks whether a function is valid (inputs, outputs are of valid type and all variables are defined) and adds it to the symbol table
 addFunction :: ([Type], [Symbol]) -> Function -> Either [TypeCheckError] [Symbol]
 addFunction (definedTypes, definedSymbols) (MakeFunction name _ inps out _)
     | null (lefts checkedInputs) && isRight checkedOutput = Right $ Func name (map attributeType (rights checkedInputs)) (attributeType $ fromRightUnsafe checkedOutput) : allSymbols
@@ -62,10 +65,12 @@ addFunction (definedTypes, definedSymbols) (MakeFunction name _ inps out _)
         checkedOutput = head $ checkAttributes definedTypes [out]
         allSymbols = addVariables definedSymbols inps
         
+-- |Adds a newly defined variable to the symbol table
 addVariables :: [Symbol] -> [TypeAttribute] -> [Symbol]
 addVariables s [] = s
 addVariables s ((MakeTypeAttribute name typ _ _)  : vars) = Var name typ : addVariables s vars
         
+-- |Checks the type of a given expression
 checkExpression :: [Symbol] -> Expression -> Either TypeCheckError Type
 checkExpression symbolMap (Variable var) = findVarType var symbolMap
 checkExpression _ (Int _) = Right $ BasicType "Integer"
@@ -78,10 +83,12 @@ checkExpression symbolMap (PrefixExp name ex) = checkFunctionCall symbolMap name
 checkExpression symbolMap (Function name exps) = checkFunctionCall symbolMap name (map (checkExpression symbolMap) exps)
 checkExpression symbolMap (PostfixExp name ex) = checkFunctionCall symbolMap name [checkExpression symbolMap ex]
 checkExpression symbolMap (InfixExp name ex1 ex2) = checkFunctionCall symbolMap name (checkExpression symbolMap ex1: [checkExpression symbolMap ex2])
+-- |Checks if the condition of an if expression is of type boolean, and then checks the expression of the then statement
 checkExpression symbolMap (IfSimple cond ex)
     | isRight condType && isRight (typeMatch (fromRightUnsafe condType) (BasicType "Boolean")) = checkExpression symbolMap ex
     | otherwise = Left IfConditionNotBoolean
     where condType = checkExpression symbolMap cond
+-- |Checks if the condition of the if statement is of type boolean, and then checks that both the then and else statements have the same type
 checkExpression symbolMap (IfElse cond ex1 ex2)
     | isRight condType || isRight (typeMatch (fromRightUnsafe condType) (BasicType "Boolean")) = Left IfConditionNotBoolean 
     | isRight ex1Type || isRight ex2Type || isRight (typeMatch (fromRightUnsafe ex1Type) (fromRightUnsafe ex2Type)) = Left IfExpressionsDifferentTypes
@@ -90,12 +97,14 @@ checkExpression symbolMap (IfElse cond ex1 ex2)
             ex1Type = checkExpression symbolMap ex1
             ex2Type = checkExpression symbolMap ex2
 
+-- |Checks that all the expressions in a list have compatible types
 checkList :: [Symbol] -> [Expression] -> Either TypeCheckError Type
 checkList symbs exps
     | isRight typ && fromRightUnsafe typ == BasicType "Any" = Right $ BasicType "Empty"
     | otherwise = typ
     where typ = checkList1 symbs exps (BasicType "Any") 
 
+-- |Auxiliary function for the check list function
 checkList1 :: [Symbol] -> [Expression] -> Type -> Either TypeCheckError Type
 checkList1 _ [] typ = Right typ
 checkList1 symbs (ex : exps) typ 
@@ -106,6 +115,7 @@ checkList1 symbs (ex : exps) typ
         exTyp = checkExpression symbs ex 
         match = typeMatch typ (fromRightUnsafe exTyp)
 
+-- |Checks whether the function that is called is already defined with the same argument types
 checkFunctionCall :: [Symbol] -> String -> [Either TypeCheckError Type] -> Either TypeCheckError Type
 checkFunctionCall [] fun args = Left $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ concatMap typeName (rights args) ++ "]"
 checkFunctionCall ((Func n a r):symbolMap) name args
@@ -116,6 +126,7 @@ checkFunctionCall ((Func n a r):symbolMap) name args
 checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name args 
 
 --Try to match 2nd type to first type
+-- |Checks whether two types are compatible
 typeMatch :: Type -> Type -> Either TypeCheckError Type
 typeMatch (BasicType "Any") x = Right x
 typeMatch (BasicType "Double") (BasicType "Integer") = Right $ BasicType "Dobule"
@@ -127,6 +138,7 @@ typeMatch s s2
     | isJust $ superType s2 = typeMatch s (fromJust $ superType s2)
     | otherwise = Left $ TypeMismatch (typeName s) (typeName s2)
 
+-- |Looks in the symbol map for the type of a variable
 findVarType :: String -> [Symbol] -> Either TypeCheckError Type
 findVarType var [] = Left $ UndefinedVariable var
 findVarType x ((Var name typ):symbols) 

src/Semantic/FunctionChecker.hs

@@ -6,6 +6,7 @@ import Semantic.ExpressionChecker
 import Semantic.TypeChecker
 import Data.Either
 
+-- |Checks if all the inputs and the out of a function call have valid types, and then checks that the assign-output expression is valid
 checkFunction :: ([Type], [Symbol]) ->  Function -> Either [TypeCheckError] Function
 checkFunction (definedTypes, definedFunctions) (MakeFunction name desc inp out ex)
     | isRight checkedEx && isRight checkedOut && null (lefts checkedIn) = Right $ MakeFunction name desc (rights checkedIn) (fromRightUnsafe checkedOut) ex

src/Semantic/TypeChecker.hs

@@ -3,6 +3,7 @@ module Semantic.TypeChecker where
 import Model.Type
 import Data.Either
 
+-- |A datatype for the different types of type check errors
 data TypeCheckError =
    UndefinedType String
    | IfConditionNotBoolean
@@ -13,6 +14,7 @@ data TypeCheckError =
    | TypeMismatch String String
    deriving (Show)
 
+-- |Checks whether a data type is valid
 checkType :: [Type] -> Type -> Either [TypeCheckError] Type
 checkType definedTypes (MakeType name super desc attr)
     | null (lefts checkedAttr) = Right $ MakeType name super desc (rights checkedAttr)
@@ -20,6 +22,8 @@ checkType definedTypes (MakeType name super desc attr)
     where checkedAttr = checkAttributes definedTypes attr 
 checkType _ (BasicType b) = Right (BasicType b)
 
+
+-- |Checks whether all the types of the attributes of a data type are already defined
 checkAttributes :: [Type] -> [TypeAttribute] -> [Either TypeCheckError TypeAttribute]
 checkAttributes _ [] = []
 checkAttributes definedTypes ((MakeTypeAttribute name typ crd desc):as)
@@ -27,6 +31,7 @@ checkAttributes definedTypes ((MakeTypeAttribute name typ crd desc):as)
     | otherwise = Left (fromLeftUnsafe checked) : checkAttributes definedTypes as
     where checked = checkAttributeType definedTypes typ 
 
+-- |Checks whether a type is predefined or in the symbol table
 checkAttributeType :: [Type] -> Type -> Either TypeCheckError Type
 checkAttributeType _ (MakeType "int" _ _ _) = Right $ BasicType "Integer"
 checkAttributeType _ (MakeType "string" _ _ _) = Right $ BasicType "String"
@@ -37,16 +42,21 @@ checkAttributeType definedTypes name
     | name `elem` definedTypes = Right name
     | otherwise = Left $ UndefinedType (typeName name)
     
+-- |Add a list of defined types to the symbol table
 addDefinedTypes :: [Type] -> [Type] -> [Type]
 addDefinedTypes l [] = l
 addDefinedTypes l (BasicType _ : ts) = addDefinedTypes l ts
 addDefinedTypes l (t:ts) = t : addDefinedTypes l ts
 
+-- |Auxiliary function to get the right value from an either that stops with an error if the value is left
+-- used when it is certain that the value will be right
 fromRightUnsafe :: (Show a) => Either a b -> b
 fromRightUnsafe x = case x of
     Left a -> error ("Value is Left" ++ show a)
     Right b -> b
     
+-- |Auxiliary function to get the left value from an either that stops with an error if the value is right
+-- used when it is certain that the value will be left
 fromLeftUnsafe :: Either a b -> a
 fromLeftUnsafe x = case x of
     Left a -> a