Working Version 0.0.1

app/Main.hs

@@ -26,19 +26,14 @@ import Utils.Utils
 import Data.Text (Text)
 
 -- :set args resources/Rosetta/test-all.rosetta
--- :l resources/Generated/testAll.hs
+-- :l resources/Generated/testAll.hs resources/Generated/testPeriod.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
     let mainFile = head args
     parseResult <- parseWithImport mainFile
-
-    --Start
-    let maps = fstlst parseResult
-    let funcs = concat $ sndlst maps
-    print funcs
-    --END
     let checked = checkObjects parseResult
     let headers = fstlst checked
     let objects = nestedRights $ sndlst checked
@@ -64,10 +59,12 @@ parseWithImport file =
                     let importedSymbolTable = fstlst (concat imports)
                     let importedTypes = concat $ fstlst importedSymbolTable
                     let importedFunctions = concat $ sndlst importedSymbolTable
-                    let definedTypes = addNewTypes importedTypes objs
+                    case addNewTypes importedTypes objs of
-                    let definedFunctions = addNewFunctions (definedTypes, importedFunctions) objs 
+                        Left errors -> error $ show errors
-                    let _ = last definedFunctions
+                        Right definedTypes ->
-                    return $ ((definedTypes, definedFunctions), (MakeHeader name desc vers imp, objs)) : concat imports
+                            case addNewFunctions (definedTypes, importedFunctions) objs of
+                                Left errors -> error $ show errors
+                                Right definedFunctions -> return $ ((definedTypes, definedFunctions), (MakeHeader name desc vers imp, objs)) : concat imports
 
 -- |Parse a file into a list of RosettaObjects
 parseFile :: String -> Either (ParseErrorBundle Text Void) (Header, [RosettaObject])
@@ -102,19 +99,22 @@ checkObject (definedTypes, definedFunctions) (FunctionObject fun) =
         Right func -> Right $ FunctionObject func
 
 -- |Adds new defined functions into the symbol table
-addNewFunctions :: ([Type], [Symbol]) -> [RosettaObject] -> [Symbol]
+addNewFunctions :: ([Type], [Symbol]) -> [RosettaObject] -> Either [TypeCheckError] [Symbol]
-addNewFunctions (_, s) [] = s
+addNewFunctions (_, s) [] = Right []
-addNewFunctions (t, s) ((FunctionObject f):os)
+addNewFunctions (t, s) ((FunctionObject f):os) =
-    | isRight definedFunctions = fromRightUnsafe definedFunctions
+    case addNewFunctions (t, s) os of
-    | otherwise = error $ show (fromLeftUnsafe definedFunctions)
+        Left errors -> Left errors
-    where definedFunctions = addFunction (t, addNewFunctions (t, s) os) f
+        Right symbs -> addFunction (t, symbs) f
 addNewFunctions (t, s) (_:os) = addNewFunctions (t, s) os
 
 -- |Adds new defined types into the symbol table
-addNewTypes :: [Type] -> [RosettaObject] -> [Type]
+addNewTypes :: [Type] -> [RosettaObject] -> Either [TypeCheckError] [Type]
-addNewTypes l [] = l
+addNewTypes l [] = Right l
-addNewTypes defined (TypeObject o: os) = addDefinedTypes (addNewTypes defined os) [o]
+addNewTypes defined (TypeObject o: os) = 
-addNewTypes defined (EnumObject (MakeEnum name _ _): os) = addDefinedTypes (addNewTypes defined os) [MakeType name (BasicType "Object") Nothing []]
+    case addNewTypes defined os of
+        Left errors -> Left errors
+        Right types -> addDefinedTypes types [o]
+addNewTypes defined (EnumObject (MakeEnum name _ _): os) = addNewTypes defined (TypeObject (MakeType name (BasicType "Object") Nothing []) : os)
 addNewTypes defined (_ :os) = addNewTypes defined os
 
 -- |Parses any supported Rosetta types into a list of RosettaObject

resources/Rosetta/test-all.rosetta

@@ -36,15 +36,6 @@ func Something: <"asd">
 
     assign-output: if True and False then valuationTime
 
-func Something: <"asd">
-    inputs:
-      equity1 boolean (1..1)
-      valuationTime ObservationPrimitive (1..1)
-    output:
-      valuation ObservationPrimitive (0..*)
-
-    assign-output: if True and False then valuationTime
-
 func SomethingElse: <"dsa">
     inputs:
       valuationTime ObservationPrimitive (1..1)

src/Model/Type.hs

@@ -1,7 +1,5 @@
 module Model.Type where
 
-import Data.Time.LocalTime()
-
 -- |The representation of a Rosetta data type
 data Type = MakeType {
         typeName :: String,

src/PrettyPrinter/Type.hs

@@ -29,7 +29,7 @@ printAttributes objName (at : ats) = (printAttribute objName at <> ",") : printA
 printAttribute :: String -> TypeAttribute -> Doc a
 printAttribute objName (MakeTypeAttribute name typ crd description) =
     printDescription description 
-        (pretty objName <> pretty (capitalize name) <+> "::" <+> printCardinality (MakeTypeAttribute name typ crd description))
+        (pretty (uncapitalize objName) <> pretty (capitalize name) <+> "::" <+> printCardinality (MakeTypeAttribute name typ crd description))
 
 -- |Converts a Cardinality into a haskell valid Doc
 printCardinality :: TypeAttribute -> Doc a

src/Semantic/ExpressionChecker.hs

@@ -18,6 +18,15 @@ data Symbol = Var{
    argsType :: [(Type, Cardinality)],
    returnType :: (Type, Cardinality)
    } deriving (Show)
+
+instance Eq Symbol where
+    (==) (Var name1 _ _) (Var name2 _ _)
+        | name1 == name2 = True
+        | otherwise = False
+    (==) (Func name1 _ _) (Func name2 _ _)
+        | name1 == name2 = True
+        | otherwise = False
+    (==) _ _ = False
   
   
 -- |A map of the predefined functions, their arguments and their return type

src/Semantic/TypeChecker.hs

@@ -15,6 +15,7 @@ data TypeCheckError =
    | TypeMismatch String String
    | CardinalityMismatch Cardinality Cardinality
    | MultipleDeclarations String
+   | TypeNameReserved String
    deriving (Show)
 
 -- |Checks whether a data type is valid
@@ -57,9 +58,12 @@ checkAttributeType definedTypes name
     | otherwise = Left $ UndefinedType (typeName name)
     
 -- |Add a list of defined types to the symbol table
-addDefinedTypes :: [Type] -> [Type] -> [Type]
+addDefinedTypes :: [Type] -> [Type] -> Either [TypeCheckError] [Type]
-addDefinedTypes l [] = l
+addDefinedTypes l [] = Right l
-addDefinedTypes l (BasicType _ : ts) = addDefinedTypes l ts
+addDefinedTypes l (BasicType t : ts) =  Left [TypeNameReserved t] 
-addDefinedTypes l (t:ts)
+addDefinedTypes l (t:ts) =
-    | typeName t `elem` map typeName l = error $ "Multiple declarations of " ++ show t
+    case addDefinedTypes l ts of
-    | otherwise = t : addDefinedTypes l ts
+        Left error -> Left error
+        Right types -> if typeName t `elem` map typeName l
+            then Left [MultipleDeclarations $ show t]
+            else Right $ t : types

src/Utils/Utils.hs

@@ -4,10 +4,14 @@ import Data.Either
 import Data.Char
 
 
--- |Capitalise a string
+-- |Capitalize a string
 capitalize :: String -> String
 capitalize s = toUpper (head s) : tail s
 
+-- |Uncapitalize a string
+uncapitalize :: String -> String
+uncapitalize s = toLower (head s) : tail s
+
 -- |Convert a namespace to a filename
 namespaceToName :: String -> String 
 namespaceToName [] = ".rosetta"
@@ -75,6 +79,13 @@ pairRights [] = []
 pairRights ((a, c) : rst) = (a, rights c) : pairRights rst
 
 
+-- |Check a list for duplicate values. Returns a list with all the values which have duplicates
+checkDuplicates :: Eq a => [a] -> [a]
+checkDuplicates [] = []
+checkDuplicates (a : as)
+    | a `elem` as = a : checkDuplicates as
+    | otherwise = checkDuplicates as
+
 -- |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 :: Either a b -> b