changed compiler to whole folder

app/Main.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Main where
 
 import Parser.Enum
@@ -15,6 +17,7 @@ import Semantic.TypeChecker
 import Semantic.ExpressionChecker
 import Semantic.FunctionChecker
 import Model.Type
+import Model.Function
 import System.Environment.Blank (getArgs)
 import Model.Enum
 import Data.Either
@@ -23,63 +26,125 @@ import Parser.Header
 import PrettyPrinter.Header
 import Data.Tuple (fst, snd)
 import Data.Void
+import System.FilePath
 import Utils.Utils
+import System.Directory
+import Data.List
 import Data.Text (Text)
 import Parser.Expression (expressionParser)
--- :l resources/Generated/ContractDSL.hs resources/Generated/ImportsTypes.hs resources/Generated/ImportsEnums.hs
--- :set args resources/Rosetta/Contracts/contractDSL.rosetta
+-- :l resources/Generated/ContractDSL.hs resources/Generated/ImportsType.hs resources/Generated/ImportsEnum.hs
+-- :set args resources/Rosetta/Contracts/
+-- :set args resources/CDM/
 
 -- |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
-    let checked = checkObjects parseResult
+    let mainFolder = head args
+    files <- getDirectoryContents mainFolder
+    parseResult <- parseFolder [mainFolder ++ f | f <- files, f `notElem` [".", ".."]]
+    let completeFiles = [createSymbolTable f parseResult | f <- parseResult]
+    let checked = checkObjects completeFiles
     let headers = fstlst checked
     let objects = nestedRights $ sndlst checked
+    --_ <- error $ show [(map typeName t, map symbolName s) | (path, t, s, (head, obj)) <- completeFiles, path == "resources/Rosetta/Contracts/contractDSL.rosetta"]
     if null $ lefts $ concat $ sndlst checked
         then
             let input = pairRights checked in
                 mapM_ generateFile input
         else error $ show $ lefts $ concat $ sndlst checked
 
-{- |Recursively parse a file and all the imports into a list of headers and objects
-The first argument is the default directory, second argument is the file name
+{- | Parse the contents of a folder, skip any files without the Rosetta extension
+Return a list of Header, Rosettaobject, filename pairs  
 -}
-parseWithImport :: String -> IO [(([Type], [Symbol]), (Header, [RosettaObject]))]
-parseWithImport file =
+parseFolder :: [FilePath] -> IO [(FilePath, Header, [RosettaObject])]
+parseFolder [] = return []
+parseFolder (file : files) = do
+    plain <- readFile file
+    rest <- parseFolder files
+    case parseFile plain of
+        Left errorBundle -> error $ errorBundlePretty errorBundle ++ " on file " ++ file
+        Right (header, objs) ->
+            return ((file, header, objs) : rest)
+
+-- | Create the symbol table for each file from the imported types enums and functions
+createSymbolTable :: (FilePath, Header, [RosettaObject]) ->  [(FilePath, Header, [RosettaObject])] -> (FilePath, [Type], [Symbol], (Header, [RosettaObject]))
+createSymbolTable (file, MakeHeader name desc ver imp, objs) imps =
+        (file, concat (fstlst imports), concat (sndlst imports), (MakeHeader name desc ver actualImport, objs))
+        where
+            imports = [(getTypes imObjs, getFunctions imObjs) | (_, MakeHeader imName _ _ _, imObjs) <- imps, imName `elem` map getNamespace imp || imName == name]
+            actualImport = 
+                [removeChar (takeFileName (dropExtension p)) '-' | (p, MakeHeader imName _ _ _, imObjs) <- imps, imName `elem` map getNamespace imp 
+                || (imName == name && p /= file && not ("enum.rosetta" `isSuffixOf` file) && not ("type.rosetta" `isSuffixOf` file && "func.rosetta" `isSuffixOf` p))]
+
+-- |Get the defined data types from a list of rosetta objects
+getTypes :: [RosettaObject] -> [Type]
+getTypes [] = []
+getTypes (TypeObject o : os) = o{typeAttributes = map convertAttributeType (typeAttributes o)} : getTypes os
+getTypes (EnumObject o : os) = convertEnumToType o : getTypes os
+getTypes (FunctionObject o : os) = getTypes os
+
+convertAttributeType :: TypeAttribute -> TypeAttribute
+convertAttributeType (MakeTypeAttribute n (MakeType "int" _ _ _ _) c d) = MakeTypeAttribute n (BasicType "Integer") c d
+convertAttributeType (MakeTypeAttribute n (MakeType "string" _ _ _ _) c d) = MakeTypeAttribute n (BasicType "String") c d
+convertAttributeType (MakeTypeAttribute n (MakeType "number" _ _ _ _) c d) = MakeTypeAttribute n (BasicType "Double") c d
+convertAttributeType (MakeTypeAttribute n (MakeType "boolean" _ _ _ _) c d) = MakeTypeAttribute n (BasicType "Bool") c d
+convertAttributeType (MakeTypeAttribute n (MakeType "time" _ _ _ _) c d) = MakeTypeAttribute n (BasicType "Time") c d
+convertAttributeType t = t
+
+getFunctions :: [RosettaObject] -> [Symbol]
+getFunctions [] = []
+getFunctions (FunctionObject o : os) = functionToSymbol o : getFunctions os
+getFunctions (o : os) = getFunctions os
+
+functionToSymbol :: Function -> Symbol
+functionToSymbol (MakeFunction (MakeFunctionSignature name _ inp out) _ _) = Func name [(attributeType (convertAttributeType i), Model.Type.cardinality i)| i <- inp] (attributeType out, Model.Type.cardinality out)
+
+{- |Recursively parse a file and all the imports into a list of headers and objects
+The first argument is a list of files already parsed (to handle cyclic imports) and the second is the name of the file to be parsed
+-}
+parseWithImport :: [String] -> String -> IO [(([Type], [Symbol]), (Header, [RosettaObject]))]
+parseWithImport files file
+    | file `elem` files = error $ "cyclic dependency on " ++ file
+    | otherwise =
     do
         plain <- readFile file
         case parseFile plain of
             Left errorBundle -> error $ errorBundlePretty errorBundle ++ "on file" ++ file
             Right (MakeHeader name desc vers imp, objs) ->
                 do
-                    let files = map ((++) (fileDirectory file) . namespaceToName) imp
-                    imports <- mapM parseWithImport files
+                    let modules = map namespaceToName imp
+                    importFiles <- getFiles modules
+                    imports <- mapM (parseWithImport (file : files)) importFiles
                     let importedSymbolTable = fstlst (concat imports)
                     let importedTypes = concat $ fstlst importedSymbolTable
                     let importedFunctions = concat $ sndlst importedSymbolTable
                     case addNewTypes importedTypes objs of
-                        Left errors -> error $ show errors
+                        Left errors -> error $ show errors ++ "\n on file " ++ file
                         Right definedTypes -> case addNewFunctions (definedTypes, importedFunctions) objs of
-                            Left errors -> error $ show errors
+                            Left errors -> error $ show errors ++ "\n on file " ++ file
                             Right definedFunctions -> return $ ((definedTypes, definedFunctions), (MakeHeader name desc vers imp, objs)) : concat imports
 
+
+getFiles :: [String] -> IO [String]
+getFiles [] = return []
+getFiles (n : ns)
+    | ".*" `isSuffixOf` n = do
+        files <- getDirectoryContents $ takeDirectory n
+        rest <- getFiles ns
+        return $ [f | f <- files, dropExtension n `isPrefixOf` f] ++ rest
+    | otherwise = do
+        files <- getFiles ns
+        return (n : files)
+
 -- |Parse a file into a list of RosettaObjects
 parseFile :: String -> Either (ParseErrorBundle Text Void) (Header, [RosettaObject])
 parseFile plainText = parse rosettaParser "" (Text.pack plainText)
 
--- |Converts a RosettaObject into a plain haskell string
--- printObject :: CheckedRosettaObject -> String
--- printObject (CheckedTypeObject t) = printType t
--- printObject (CheckedFunctionObject f) = printFunction f
--- printObject (CheckedEnumObject e) = printEnum e
-
 -- |Checks all the objects from a list
-checkObjects :: [(([Type], [Symbol]), (Header, [RosettaObject]))] -> [(Header, [Either [TypeCheckError] CheckedRosettaObject])]
+checkObjects :: [(FilePath, [Type], [Symbol], (Header, [RosettaObject]))] -> [((FilePath, Header), [Either [TypeCheckError] CheckedRosettaObject])]
 checkObjects [] = []
-checkObjects (((definedTypes, definedSymbols), (header, objs)) : rest) = (header, checked) : checkObjects rest
+checkObjects ((file, definedTypes, definedSymbols, (header, objs)) : rest) = ((file, header), checked) : checkObjects rest
     where
         checked = map (checkObject (definedTypes, definedSymbols)) objs
 
@@ -110,7 +175,7 @@ addNewFunctions (t, s) (_:os) = addNewFunctions (t, s) os
 -- |Adds new defined types into the symbol table
 addNewTypes :: [Type] -> [RosettaObject] -> Either [TypeCheckError] [Type]
 addNewTypes l [] = Right l
-addNewTypes defined (TypeObject o: os) = 
+addNewTypes defined (TypeObject o: os) =
     case addNewTypes defined os of
         Left errors -> Left errors
         Right types -> addDefinedTypes types [o]
@@ -140,5 +205,7 @@ parseFunction = do
     FunctionObject <$> functionParser
 
 -- |Generate a new haskell file based on the rosetta objects and header
-generateFile :: (Header, [CheckedRosettaObject]) -> IO ()
-generateFile (header, objects) = writeFile (haskellFileName $ namespace header) (printHeader header ++ concatMap printRosettaObject objects)
+generateFile :: ((FilePath, Header), [CheckedRosettaObject]) -> IO ()
+generateFile ((path, header), objects) =
+    writeFile (haskellFileName $ dropExtension $ takeFileName path)
+    (printHeader (dropExtension $ takeFileName path) header ++ concatMap printRosettaObject objects)