Parser and type checker almost completely working

Added testing env

RosettaParser.cabal

@@ -6,12 +6,12 @@ cabal-version: 1.12
 
 name:           RosettaParser
 version:        0.1.0.0
-description:    Please see the README on GitHub at <https://github.com/githubuser/RosettaParser#readme>
+description:    Please see the README on GitHub at <https://github.com/macocianradu/RosettaParser#readme>
-homepage:       https://github.com/githubuser/RosettaParser#readme
+homepage:       https://github.com/macocianradu/RosettaParser#readme
-bug-reports:    https://github.com/githubuser/RosettaParser/issues
+bug-reports:    https://github.com/macocianradu/RosettaParser/issues
-author:         Author name here
+author:         Adrian Radu Macocian
-maintainer:     example@example.com
+maintainer:     rmacocian@gmail.com
-copyright:      2021 Author name here
+copyright:      2021 Adrian Radu Macocian
 license:        BSD3
 license-file:   LICENSE
 build-type:     Simple
@@ -21,7 +21,7 @@ extra-source-files:
 
 source-repository head
   type: git
-  location: https://github.com/githubuser/RosettaParser
+  location: https://github.com/macocianradu/RosettaParser
 
 library
   exposed-modules:
@@ -37,6 +37,7 @@ library
       PrettyPrinter.Function
       PrettyPrinter.General
       PrettyPrinter.Type
+      Semantic.ExpressionChecker
       Semantic.TypeChecker
   other-modules:
       Paths_RosettaParser
@@ -54,8 +55,6 @@ library
 
 executable RosettaParser-exe
   main-is: Main.hs
-  other-modules:
-      Paths_RosettaParser
   hs-source-dirs:
       app
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
@@ -74,6 +73,9 @@ test-suite RosettaParser-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Parser.EnumSpec
+      Parser.ExpressionSpec
+      Parser.TypeSpec
       Paths_RosettaParser
   hs-source-dirs:
       test
@@ -81,6 +83,8 @@ test-suite RosettaParser-test
   build-depends:
       RosettaParser
     , base >=4.7 && <5
+    , hspec
+    , hspec-megaparsec
     , megaparsec
     , mtl
     , parser-combinators

RosettaParser.iml

@@ -33,5 +33,25 @@
     <orderEntry type="library" name="pretty-1.1.3.6" level="project" />
     <orderEntry type="library" name="time-1.9.3" level="project" />
     <orderEntry type="library" name="prettyprinter-1.7.0" level="project" />
+    <orderEntry type="library" name="hspec-2.7.10" level="project" />
+    <orderEntry type="library" name="QuickCheck-2.14.2" level="project" />
+    <orderEntry type="library" name="hspec-core-2.7.10" level="project" />
+    <orderEntry type="library" name="hspec-discover-2.7.10" level="project" />
+    <orderEntry type="library" name="hspec-expectations-0.8.2" level="project" />
+    <orderEntry type="library" name="random-1.2.0" level="project" />
+    <orderEntry type="library" name="splitmix-0.1.0.3" level="project" />
+    <orderEntry type="library" name="HUnit-1.6.2.0" level="project" />
+    <orderEntry type="library" name="ansi-terminal-0.11" level="project" />
+    <orderEntry type="library" name="call-stack-0.3.0" level="project" />
+    <orderEntry type="library" name="clock-0.8.2" level="project" />
+    <orderEntry type="library" name="directory-1.3.6.0" level="project" />
+    <orderEntry type="library" name="filepath-1.4.2.1" level="project" />
+    <orderEntry type="library" name="quickcheck-io-0.2.0" level="project" />
+    <orderEntry type="library" name="setenv-0.1.1.3" level="project" />
+    <orderEntry type="library" name="stm-2.5.0.1" level="project" />
+    <orderEntry type="library" name="tf-random-0.5" level="project" />
+    <orderEntry type="library" name="colour-2.3.6" level="project" />
+    <orderEntry type="library" name="unix-2.7.2.2" level="project" />
+    <orderEntry type="library" name="hspec-megaparsec-2.2.0" level="project" />
   </component>
 </module>

app/Main.hs

@@ -8,10 +8,9 @@ import Text.Megaparsec
 import PrettyPrinter.Enum
 import PrettyPrinter.Type
 import PrettyPrinter.Function
-import Parser.Expression
 import Semantic.TypeChecker
 import Model.Function
-import Model.Type (typeAttributes)
+import Model.Type
 
 main :: IO ()
 main = do
@@ -25,24 +24,24 @@ main = do
 
 testEnum :: IO()
 testEnum = do
-    rosettaString <- readFile "src/TestFiles/testEnum.rosetta"
+    rosettaString <- readFile "resources/Enums/testEnum5.rosetta"
     case parse enumParser "" (Text.pack rosettaString) of
-        Left errorBundle -> print (errorBundlePretty errorBundle)
+        Left errorBundle -> print errorBundle
         Right enum -> 
             do
                 putStrLn $ printEnum enum
-                writeFile "src/TestFiles/typeEnum.hs" (printEnum enum) 
+                writeFile "resources/Generated/generatedEnum.hs" (printEnum enum) 
         
 testTypeParser :: IO()
 testTypeParser = do
-    rosettaString <- readFile "src/TestFiles/testType.rosetta"
+    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 "src/TestFiles/typeTest.hs" (printType typ) 
+                writeFile "resources/Generated/generatedType.hs" (printType typ) 
               
 testTypeChecker :: IO ()
 testTypeChecker = do
@@ -56,52 +55,11 @@ testTypeChecker = do
                 
 testFunc :: IO()
 testFunc = do
-    rosettaString <- readFile "src/TestFiles/testFunction.rosetta"
+    rosettaString <- readFile "resources/testFunction.rosetta"
     case parse functionParser "" (Text.pack rosettaString) of
         Left errorBundle -> print (errorBundlePretty errorBundle)
         Right fun -> 
             do
                 print $ printFunctionSignature fun
                 print (assignments fun)
-                writeFile "src/TestFiles/functionTest.hs" (show $ printFunctionSignature fun) 
+                writeFile "resources/Generated/generatedFunction.hs" (show $ printFunctionSignature fun) 
-           
-testExpTypeChecker :: IO ()
-testExpTypeChecker = putStrLn $ printOnOneLine $ mapExpsToTypes expressions
-                
-mapExpsToTypes :: [String] -> [(String, String)]
-mapExpsToTypes [] = []
-mapExpsToTypes (expr: exps) = do
-    case parse expressionParser "" (Text.pack expr) of
-        Left errorBundle -> error (errorBundlePretty errorBundle)
-        Right ex -> (show ex, show $ checkExpression defaultMap ex) :mapExpsToTypes exps
-        
-printOnOneLine :: [(String, String)] -> String
-printOnOneLine [] = ""
-printOnOneLine ((ex, typ): exps) = "(" ++ ex ++ "," ++ typ ++ ")\n" ++ printOnOneLine exps 
-            
-expressions :: [String]
-expressions = [
-  --Or Good
-  "True or False",
-  --Or Bad
-  "1 or False",
-  --And Good
-  "False and False",
-  --And Bad
-  "1 and 2",
-  --Exists Good
-  "a exists",
-  --Plus Good
-  "1.2 + 2.3",
-  "1 + 2.3",
-  "1 + 2",
-  --Plus Bad
-  "True + 2",
-  --If Good
-  "if True then 2 else 3",
-  --If Bad Cond
-  "if 2 then True else False",
-  --If Bad exps
-  "if True then 2 else False",
-  "if True or False then 24 + 15 else 55 + 98 + 35 + 34"
-  ]

package.yaml

@@ -1,10 +1,10 @@
 name:                RosettaParser
 version:             0.1.0.0
-github:              "githubuser/RosettaParser"
+github:              "macocianradu/RosettaParser"
 license:             BSD3
-author:              "Author name here"
+author:              "Adrian Radu Macocian"
-maintainer:          "example@example.com"
+maintainer:          "rmacocian@gmail.com"
-copyright:           "2021 Author name here"
+copyright:           "2021 Adrian Radu Macocian"
 
 extra-source-files:
 - README.md
@@ -17,7 +17,7 @@ extra-source-files:
 # To avoid duplicated efforts in documentation and dealing with the
 # complications of embedding Haddock markup inside cabal files, it is
 # common to point users to the README.md file.
-description:         Please see the README on GitHub at <https://github.com/githubuser/RosettaParser#readme>
+description:         Please see the README on GitHub at <https://github.com/macocianradu/RosettaParser#readme>
 
 dependencies:
 - base >= 4.7 && < 5
@@ -41,6 +41,9 @@ executables:
     - -with-rtsopts=-N
     dependencies:
     - RosettaParser
+    when:
+    - condition: false
+      other-modules: Paths_RosettaParser
 
 tests:
   RosettaParser-test:
@@ -52,3 +55,5 @@ tests:
     - -with-rtsopts=-N
     dependencies:
     - RosettaParser
+    - hspec-megaparsec
+    - hspec

resources/Enums/testEnum1.rosetta

@@ -0,0 +1,4 @@
+enum PeriodEnum: <"The enumerated values to specified the period, e.g. day, week.">
+    D displayName "day" <"Day">
+    M displayName "month" <"Month">
+    Y displayName "year" <"Year">

resources/Enums/testEnum2.rosetta

@@ -0,0 +1,4 @@
+enum EnumWithoutDisplay: <"The enumerated values to specified the period, e.g. day, week.">
+    D <"Day">
+    M <"Month">
+    Y <"Year">

resources/Enums/testEnum3.rosetta

@@ -0,0 +1,3 @@
+enum EnumWithoutDescription:
+    X displayName "xs"
+    Y displayName "ys"

resources/Enums/testEnum4.rosetta

@@ -0,0 +1,3 @@
+enum Wrong:
+    A <"asd"> displayName "dsa"
+    B <"xyz"> displayName "zyx"

resources/Enums/testEnum5.rosetta

@@ -0,0 +1,3 @@
+enum Wrong2
+    A <"asd"> displayName "dsa"
+    B <"xyz"> displayName "zyx"

resources/Enums/testEnum6.rosetta

@@ -0,0 +1,3 @@
+enum Wrong3::
+    A <"asd"> displayName "dsa"
+    B <"xyz"> displayName "zyx"

resources/Types/testType1.rosetta

@@ -0,0 +1,6 @@
+type Period: <"description">
+    periodMultiplier int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">
+    testMany TestType (0..*) <"Test many">
+    testSome TestSomeType (1..*) <"Test some">
+    testMaybeOne TestZeroOneType (0..1) <"Test zero or one">
+    testAll Test (2..15) <"Test all">

resources/Types/testType2.rosetta

@@ -0,0 +1,2 @@
+type TestType:
+    periodMultiplier int (1..1)

resources/Types/testType3.rosetta

@@ -0,0 +1,2 @@
+type TestSomeType: <"description">
+    periodMultiplier int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">

resources/Types/testType4.rosetta

@@ -0,0 +1,2 @@
+type TestZeroOneType extends Period:
+    periodMultiplier int (1..1)

resources/Types/testType5.rosetta

@@ -0,0 +1,2 @@
+type WrongCardinality: <"description">
+    periodMultiplier int (1.1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">

resources/Types/testType6.rosetta

@@ -0,0 +1,2 @@
+type WrongCardinality2: <"description">
+    periodMultiplier int (1..a) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">

resources/Types/testType7.rosetta

@@ -0,0 +1,2 @@
+type MissingType: <"description">
+    periodMultiplier (1.1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">

src/Model/Enum.hs

@@ -4,10 +4,10 @@ data EnumType = MakeEnum {
     enumName :: String,
     enumDescription :: Maybe String,
     enumValues :: [EnumValue]
-} deriving (Show)
+} deriving (Show, Eq)
 
 data EnumValue = MakeEnumValue {
     enumValueName :: String,
     enumValueDescription :: Maybe String,
     enumValueDisplayName :: Maybe String
-} deriving (Show)
+} deriving (Show, Eq)

src/Model/Function.hs

@@ -12,16 +12,16 @@ data Function =
     }
     deriving (Show)
     
-data Condition =
+--data Condition =
-    MakeCondition {
+--    MakeCondition {
-        conditionDescription :: Maybe String,
+--        conditionDescription :: Maybe String,
-        conditionStatement :: Expression
+--        conditionStatement :: Expression
-    }
+--    }
-    | MakePostCondition {
+--    | MakePostCondition {
-        conditionDescription :: Maybe String,
+--        conditionDescription :: Maybe String,
-        conditionStatement :: Expression
+--        conditionStatement :: Expression
-    }
+--    }
-    deriving (Show)
+--    deriving (Show)
      
 data Expression = Variable String
     | Int String
@@ -36,4 +36,4 @@ data Expression = Variable String
     | InfixExp String Expression Expression
     | IfSimple Expression Expression
     | IfElse Expression Expression Expression
-    deriving (Show)
+    deriving (Eq, Show)

src/Model/Type.hs

@@ -30,9 +30,7 @@ data TypeAttribute = MakeTypeAttribute {
 } deriving (Show)
 
 --TODO use bounded class
-data Cardinality = 
+data Cardinality = Bounds (Integer, Integer)
-    ZeroOrOne
+  | OneBound Integer
-    | ExactlyOne
+  | NoBounds 
-    | OneOrMore             -- One or more
+  deriving Show
-    | ZeroOrMore            -- Zero or more
-    deriving (Show)

src/Parser/Enum.hs

@@ -7,16 +7,14 @@ import Text.Megaparsec.Char
 import Text.Megaparsec
 import Model.Enum
 
---parseTest enumParser "enum periodEnum: <\"description\"> D displayName \"day\" <\"Day\">"
 enumParser :: Parser EnumType
 enumParser = 
     do 
         eName <- enumNameParser
         eDescription <- optional descriptionParser
-        values <- many enumValueParser
+        values <- some enumValueParser
         return (MakeEnum eName eDescription values)
-
+    
---parseTest enumValueParser "D displayName \"day\" <\"Day\">"        
 enumValueParser :: Parser EnumValue
 enumValueParser = 
     do
@@ -38,24 +36,4 @@ enumNameParser =
         _ <- lexeme $ string "enum"
         name <- nameParser
         _ <- lexeme $ char ':'
-        return name 
+        return name 
-
-periodEnum :: EnumType
-periodEnum = MakeEnum 
-    "PeriodEnum" 
-    (Just "The enumerated values to specifie the period, e.g. day, week.")
-    [MakeEnumValue 
-    "D"
-    (Just "Day")
-    Nothing,
-    
-    MakeEnumValue
-    "W"
-    (Just "Week")
-    Nothing,
-    
-    MakeEnumValue
-    "Y"
-    (Just "Year")
-    Nothing
-    ]

src/Parser/Expression.hs

@@ -75,7 +75,7 @@ integerParser :: Parser Expression
 integerParser =
     do
         nr <- lexeme $ some digitChar
-        return $ Int $ show nr
+        return $ Int nr
         
 decimalParser :: Parser Expression
 decimalParser =
@@ -83,7 +83,7 @@ decimalParser =
         nr <- some digitChar
         _ <- char '.'
         real <- lexeme $ many digitChar
-        return $ Real $ show nr ++ "." ++ real
+        return $ Real $ nr ++ "." ++ real
         
 booleanParser :: Parser Expression
 booleanParser =
@@ -202,18 +202,4 @@ precedence "^" = 4
 precedence _ = 100
 
 prefixOperators :: [String]
-prefixOperators = ["-", "not"]
+prefixOperators = ["-", "not"]
-
-testArith3 = parseTest expressionParser "1 + (2 - 3)"
-testArith4 = parseTest expressionParser "a * b - c * d - e * f = g * h - i * j - k * l"
-testArith5 = parseTest expressionParser "a + b - c * d ^ e"
-testArith6 = parseTest expressionParser "1 - 2 - 3 - 4 - 5 - 6"
-testList = parseTest expressionParser "[1, 2, 3]"
-testList2 = parseTest expressionParser "[1, 2 + 3, e]"
-testFun = parseTest functionCallParser "Function()"
-testFun2 = parseTest functionCallParser "Function(e)"
-testFun3 = parseTest functionCallParser "Function(3, 3+2,e)"
-testIf = parseTest expressionParser "if (Function(2 + 3, e)) then a + b - c * d ^ e -> x else not a exists"
-testEverything = parseTest expressionParser "if [1, Function(3)] then 1 - 2 - 3 * a -> b ^ c"
-testFail = parseTest expressionParser "if[1,as]thenxandoelseaora"
-testOr = parseTest expressionParser "a or b"

src/Parser/Type.hs

@@ -7,7 +7,6 @@ import Text.Megaparsec.Char
 import Text.Megaparsec
 import Parser.General 
   
---parseTest typeParser "type Period: <\"description\"> periodMultiplier int (1..1) <\"A time period multiplier\"> period periodEnum (1..1) <\"A time period \">"
 typeParser :: Parser Type
 typeParser = 
     do 
@@ -21,7 +20,7 @@ typeParser =
 superTypeParser :: Parser Type
 superTypeParser =
     do
-        _ <- lexeme $ string "extending"
+        _ <- lexeme $ string "extends"
         name <- pascalNameParser 
         return $ MakeType name Nothing Nothing []
 
@@ -37,55 +36,36 @@ typeAttributeParser =
 cardinalityParser :: Parser Cardinality
 cardinalityParser =
     do
-        parseExactlyOne <|> parseOneOrMore <|> parseZeroOrMore <|> parseZeroOrOne
+        try parseBounded <|> try parseSemiBounded <|> try parseUnbounded
 
-parseOneOrMore :: Parser Cardinality
+parseBounded :: Parser Cardinality
-parseOneOrMore = 
+parseBounded = 
     do
-        _ <- lexeme $ string "(1..*)"
+        _ <- lexeme $ char '('
-        return OneOrMore
+        low <- lexeme $ many digitChar
+        _ <- lexeme $ string ".."
+        up <- lexeme $ many digitChar
+        _ <- lexeme $ char ')'
+        return $ Bounds (read low, read up)
 
 
-parseExactlyOne :: Parser Cardinality
+parseSemiBounded :: Parser Cardinality
-parseExactlyOne = 
+parseSemiBounded = 
     do
-        _ <- lexeme $ string "(1..1)"
+        _ <- lexeme $ char '('
-        return ExactlyOne
+        low <- lexeme $ many digitChar
+        _ <- lexeme $ string "..*)"
+        return $ OneBound $ read low
         
         
-parseZeroOrMore :: Parser Cardinality
+parseUnbounded :: Parser Cardinality
-parseZeroOrMore = 
+parseUnbounded = 
     do
-        _ <- lexeme $ string "(0..*)"
+        _ <- lexeme $ string "(*..*)"
-        return ZeroOrMore
+        return NoBounds
-        
-        
-parseZeroOrOne :: Parser Cardinality
-parseZeroOrOne = 
-    do
-        _ <- lexeme $ string "(0..1)"
-        return ZeroOrOne
 
 typeNameParser :: Parser String
 typeNameParser = 
     do
         _ <- lexeme $ string "type"
-        pascalNameParser
+        pascalNameParser
-        
-periodType :: Type
-periodType = MakeType 
-    "Period" 
-    Nothing
-    (Just "A class to define recurring periods or time offsets")
-    [MakeTypeAttribute 
-        "periodMultiplier"
-        (BasicType "Integer")
-        ExactlyOne
-        (Just "A time period multiplier"),
-    
-    MakeTypeAttribute 
-        "period"
-        (MakeType "PeriodEnum" Nothing Nothing [])
-        ExactlyOne
-        (Just "A time period")
-    ]

src/PrettyPrinter/Type.hs

@@ -8,16 +8,24 @@ import Model.Type
 
 printType :: Type -> String
 printType (MakeType name _ description attributes) =
-    show $ printDescription description (vcat [nest 4 $ vcat("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": map printAttribute attributes), "}", ""])
+    show $ printDescription description (vcat [nest 4 $ vcat ("data" <+> pretty name <+> "=" <+> "Make" <> pretty name <+> "{": map printAttribute attributes), "}", ""])
 printType (BasicType name) = show $ pretty name
    
+printAttributes :: [TypeAttribute] -> [Doc a]
+printAttributes [] = []
+printAttributes [at] = [printAttribute at]
+printAttributes (at : ats) = (printAttribute at <> ",") : printAttributes ats
+
+   
 printAttribute :: TypeAttribute -> Doc a
 printAttribute (MakeTypeAttribute name typ crd description) =
     printDescription description 
         (pretty name <+> "::" <+> printCardinality (MakeTypeAttribute name typ crd description))   
 
 printCardinality :: TypeAttribute -> Doc a
-printCardinality (MakeTypeAttribute _ typ ExactlyOne _) = pretty (typeName typ)
+printCardinality (MakeTypeAttribute _ typ (Bounds (x, y)) _)
-printCardinality (MakeTypeAttribute _ typ OneOrMore _) = "[" <> pretty (typeName typ) <> "]"
+    | x == 0 && y == 1 = "Maybe" <+> pretty (typeName typ)
-printCardinality (MakeTypeAttribute _ typ ZeroOrMore _) = "[" <> pretty (typeName typ) <> "]"
+    | x == 1 && y == 1 = pretty (typeName typ)
-printCardinality (MakeTypeAttribute _ typ ZeroOrOne _) = "Maybe" <+> pretty (typeName typ)
+    | otherwise = "[" <> pretty (typeName typ) <> "]"
+printCardinality (MakeTypeAttribute _ typ NoBounds _) = "[" <> pretty (typeName typ) <> "]"
+printCardinality (MakeTypeAttribute _ typ (OneBound _) _) = "[" <> pretty (typeName typ) <> "]"

src/Semantic/ExpressionChecker.hs

@@ -0,0 +1,131 @@
+module Semantic.ExpressionChecker where
+
+import Model.Function
+import Data.Either
+import Data.Maybe
+import Model.Type
+import Semantic.TypeChecker
+  
+data Symbol = Var{
+   varName :: String,
+   declaredType :: Type
+   }
+   | Func {
+   funcName :: String,
+   argsType :: [Type],
+   returnType :: Type
+   }
+  
+defaultMap :: [Symbol]
+defaultMap = [
+  Func "or" [BasicType "Boolean", BasicType "Boolean"] (BasicType "Boolean"),
+  Func "and" [BasicType "Boolean", BasicType "Boolean"] (BasicType "Boolean"),
+  Func "exists" [BasicType "Any"] (BasicType "Boolean"),
+  Func "is absent" [BasicType "Any"] (BasicType "Boolean"),
+  Func "single exists" [BasicType "Any"] (BasicType "Boolean"),
+  Func "multiple exists" [BasicType "Any"] (BasicType "Boolean"),
+  Func "contains" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "disjoint" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  
+  Func "=" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func ">=" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "<=" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "<>" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func ">" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "<" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "all =" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "all <>" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "any =" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  Func "any <>" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
+  
+  Func "+" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
+  Func "+" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
+  Func "-" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
+  Func "-" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
+  Func "*" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
+  Func "*" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
+  Func "/" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
+  Func "/" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
+  Func "^" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
+  Func "^" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
+  
+  Func "count" [BasicType "Any"] (BasicType "Integer")
+  ]
+    
+checkExpression :: [Symbol] -> Expression -> Either Type TypeCheckError
+checkExpression symbolMap (Variable var) = findVarType var symbolMap
+checkExpression _ (Int _) = Left $ BasicType "Integer"
+checkExpression _ (Real _) = Left $ BasicType "Double"
+checkExpression _ (Boolean _) = Left $ BasicType "Boolean"
+checkExpression _ Empty = Left $ BasicType "Empty"
+checkExpression symbolMap (Parens ex) = checkExpression symbolMap 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)
+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])
+checkExpression symbolMap (IfSimple cond ex)
+    | isLeft condType && isLeft (typeMatch (fromLeftUnsafe condType) (BasicType "Boolean")) = checkExpression symbolMap ex
+    | otherwise = Right IfConditionNotBoolean
+    where condType = checkExpression symbolMap cond
+checkExpression symbolMap (IfElse cond ex1 ex2)
+    | isRight condType || isRight (typeMatch (fromLeftUnsafe condType) (BasicType "Boolean")) = Right IfConditionNotBoolean 
+    | isRight ex1Type || isRight ex2Type || isRight (typeMatch (fromLeftUnsafe ex1Type) (fromLeftUnsafe ex2Type)) = Right IfExpressionsDifferentTypes
+    | otherwise = ex1Type
+    where   condType = checkExpression symbolMap cond
+            ex1Type = checkExpression symbolMap ex1
+            ex2Type = checkExpression symbolMap ex2
+
+checkList :: [Symbol] -> [Expression] -> Either Type TypeCheckError
+checkList symbs exps
+    | isLeft typ && fromLeftUnsafe typ == BasicType "Any" = Left $ BasicType "Empty"
+    | otherwise = typ
+    where typ = checkList1 symbs exps (BasicType "Any") 
+
+checkList1 :: [Symbol] -> [Expression] -> Type -> Either Type TypeCheckError
+checkList1 _ [] typ = Left typ
+checkList1 symbs (ex : exps) typ 
+    | isRight exTyp = exTyp
+    | isRight match = match
+    | otherwise = checkList1 symbs exps (fromLeftUnsafe match)
+    where 
+        exTyp = checkExpression symbs ex 
+        match = typeMatch typ (fromLeftUnsafe exTyp)
+
+checkFunctionCall :: [Symbol] -> String -> [Either Type TypeCheckError] -> Either Type TypeCheckError
+checkFunctionCall [] fun args = Right $ UndefinedFunction $ "Undefined function: \"" ++ fun ++ "\" [" ++ concatMap typeName (lefts args) ++ "]"
+checkFunctionCall ((Func n a r):symbolMap) name args
+    | length left /= length args = Right ErrorInsideFunction
+    | name == n && all isLeft (zipWith typeMatch a left) = Left r
+    | otherwise = checkFunctionCall symbolMap name args
+    where left = lefts args
+checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name args 
+
+--Try to match 2nd type to first type
+typeMatch :: Type -> Type -> Either Type TypeCheckError
+typeMatch (BasicType "Any") x = Left x
+typeMatch (BasicType "Double") (BasicType "Integer") = Left $ BasicType "Dobule"
+typeMatch s (BasicType s2)
+    | s == BasicType s2 = Left s
+    | otherwise = Right $ TypeMismatch (typeName s) s2
+typeMatch s s2
+    | s == s2 = Left s
+    | isJust $ superType s2 = typeMatch s (fromJust $ superType s2)
+    | otherwise = Right $ TypeMismatch (typeName s) (typeName s2)
+
+findVarType :: String -> [Symbol] -> Either Type TypeCheckError
+findVarType var [] = Right $ UndefinedVariable var
+findVarType x ((Var name typ):symbols) 
+    | x == name = Left typ
+    | otherwise = findVarType x symbols
+findVarType x (_:symbols) = findVarType x symbols
+
+fromRightUnsafe :: Either a b -> b
+fromRightUnsafe x = case x of
+    Left _ -> error "Value is Left"
+    Right b -> b
+    
+fromLeftUnsafe :: Either a b -> a
+fromLeftUnsafe x = case x of
+    Left a -> a
+    Right _ -> error "Value is Right"

src/Semantic/TypeChecker.hs

@@ -1,65 +1,16 @@
 module Semantic.TypeChecker where
 
 import Model.Type
-import Model.Function
-import Data.Either
-import Data.Maybe
 
 data TypeCheckError =
-    UndefinedType String
+   UndefinedType String
-    | IfConditionNotBoolean
+   | IfConditionNotBoolean
-    | IfExpressionsDifferentTypes
+   | IfExpressionsDifferentTypes
-    | UndefinedFunction String
+   | UndefinedFunction String
-    | ErrorInsideFunction
+   | ErrorInsideFunction
-    | UndefinedVariable String
+   | UndefinedVariable String
-    | TypeMismatch String String
+   | TypeMismatch String String
-    deriving (Show)
+   deriving (Show)
-
-data Symbol = Var{
-  varName :: String,
-  declaredType :: Type
-  }
-  | Func {
-  funcName :: String,
-  argsType :: [Type],
-  returnType :: Type
-  }
-
-defaultMap :: [Symbol]
-defaultMap = [
-  Func "or" [BasicType "Boolean", BasicType "Boolean"] (BasicType "Boolean"),
-  Func "and" [BasicType "Boolean", BasicType "Boolean"] (BasicType "Boolean"),
-  Func "exists" [BasicType "Any"] (BasicType "Boolean"),
-  Func "is absent" [BasicType "Any"] (BasicType "Boolean"),
-  Func "single exists" [BasicType "Any"] (BasicType "Boolean"),
-  Func "multiple exists" [BasicType "Any"] (BasicType "Boolean"),
-  Func "contains" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
-  Func "disjoint" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
-  
-  Func "=" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
-  Func ">=" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
-  Func "<=" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
-  Func "<>" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
-  Func ">" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
-  Func "<" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
-  Func "all =" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
-  Func "all <>" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
-  Func "any =" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
-  Func "any <>" [BasicType "Any", BasicType "Any"] (BasicType "Boolean"),
-  
-  Func "+" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
-  Func "+" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
-  Func "-" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
-  Func "-" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
-  Func "*" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
-  Func "*" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
-  Func "/" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
-  Func "/" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
-  Func "^" [BasicType "Integer", BasicType "Integer"] (BasicType "Integer"),
-  Func "^" [BasicType "Double", BasicType "Double"] (BasicType "Double"),
-  
-  Func "count" [BasicType "Any"] (BasicType "Integer")
-  ]
 
 checkAttributes :: [Type] -> [TypeAttribute] -> [Either Type TypeCheckError]
 checkAttributes _ [] = []
@@ -74,85 +25,8 @@ checkType _ (MakeType "time" _ _ _) = Left $ BasicType "Time"
 checkType definedTypes name
     | name `elem` definedTypes = Left name
     | otherwise = Right $ UndefinedType (typeName name)
-  
+    
 addDefinedTypes :: [Type] -> [Type] -> [Type]
 addDefinedTypes l [] = l
 addDefinedTypes l (BasicType _ : ts) = addDefinedTypes l ts
-addDefinedTypes l (t:ts) = t : addDefinedTypes l ts
+addDefinedTypes l (t:ts) = t : addDefinedTypes l ts
-
---Variable String
---    | Int String
---    | Real String
---    | Boolean String
---    | Empty
---    | Parens Expression
---    | List [Expression]
---    | Function String [Expression]
---    | PrefixExp String Expression
---    | PostfixExp String Expression
---    | InfixExp String Expression Expression
---    | IfSimple Expression Expression
---    | IfElse Expression Expression Expression
-    
-checkExpression :: [Symbol] -> Expression -> Either Type TypeCheckError
-checkExpression symbolMap (Variable var) = findVarType var symbolMap
-checkExpression _ (Int _) = Left $ BasicType "Integer"
-checkExpression _ (Real _) = Left $ BasicType "Double"
-checkExpression _ (Boolean _) = Left $ BasicType "Boolean"
-checkExpression _ Empty = Left $ BasicType "Empty"
-checkExpression symbolMap (Parens ex) = checkExpression symbolMap ex
---TODO check list has same type
-checkExpression _ (List _) = Left $ BasicType "List" 
-checkExpression symbolMap (PrefixExp name ex) = checkFunctionCall symbolMap name [checkExpression symbolMap ex]
-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])
-checkExpression symbolMap (IfSimple cond ex)
-    | isLeft condType && isLeft (typeMatch (fromLeftUnsafe condType) (BasicType "Boolean")) = checkExpression symbolMap ex
-    | otherwise = Right IfConditionNotBoolean
-    where condType = checkExpression symbolMap cond
-checkExpression symbolMap (IfElse cond ex1 ex2)
-    | isRight condType || isRight (typeMatch (fromLeftUnsafe condType) (BasicType "Boolean")) = Right IfConditionNotBoolean 
-    | isRight ex1Type || isRight ex2Type || isRight (typeMatch (fromLeftUnsafe ex1Type) (fromLeftUnsafe ex2Type)) = Right IfExpressionsDifferentTypes
-    | otherwise = ex1Type
-    where   condType = checkExpression symbolMap cond
-            ex1Type = checkExpression symbolMap ex1
-            ex2Type = checkExpression symbolMap ex2
-
-checkFunctionCall :: [Symbol] -> String -> [Either Type TypeCheckError] -> Either Type TypeCheckError
-checkFunctionCall [] fun args = Right $ UndefinedFunction $ "Undefined function: " ++ fun ++ concatMap typeName (lefts args)
-checkFunctionCall ((Func n a r):symbolMap) name args
-    | length left /= length args = Right ErrorInsideFunction
-    | name == n && all isLeft (zipWith typeMatch a left) = Left r
-    | otherwise = checkFunctionCall symbolMap name args
-    where left = lefts args
-checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name args 
-
---Try to match 2nd type to first type
-typeMatch :: Type -> Type -> Either Type TypeCheckError
-typeMatch (BasicType "Any") x = Left x
-typeMatch (BasicType "Double") (BasicType "Integer") = Left $ BasicType "Dobule"
-typeMatch s (BasicType s2)
-    | s == BasicType s2 = Left s
-    | otherwise = Right $ TypeMismatch (typeName s) s2
-typeMatch s s2
-    | s == s2 = Left s
-    | isJust $ superType s2 = typeMatch s (fromJust $ superType s2)
-    | otherwise = Right $ TypeMismatch (typeName s) (typeName s2)
-
-findVarType :: String -> [Symbol] -> Either Type TypeCheckError
-findVarType var [] = Right $ UndefinedVariable var
-findVarType x ((Var name typ):symbols) 
-    | x == name = Left typ
-    | otherwise = findVarType x symbols
-findVarType x (_:symbols) = findVarType x symbols
-
-fromRightUnsafe :: Either a b -> b
-fromRightUnsafe x = case x of
-    Left _ -> error "Value is Left"
-    Right b -> b
-    
-fromLeftUnsafe :: Either a b -> a
-fromLeftUnsafe x = case x of
-    Left a -> a
-    Right _ -> error "Value is Right"

src/TestFiles/functionTest.hs

@@ -1,7 +0,0 @@
-{-Function specification for the observation of an equity price, based on the attributes of the 'EquityValuation' class.-}
-EquityPriceObservation :: Equity
-                       -> AdjustableOrRelativeDate
-                       -> Maybe BusinessCenterTime
-                       -> Maybe TimeTypeEnum
-                       -> [DeterminationMethodEnum]
-                       -> ObservationPrimitive

src/TestFiles/testEnum.rosetta

@@ -1,4 +0,0 @@
-enum PeriodEnum: <"description">
-    D displayName "day" <"Day">
-    M displayName "month" <"Month">
-    Y displayName "year" <"Year">

src/TestFiles/testType.rosetta

@@ -1,14 +0,0 @@
-type Period: <"description">
-    periodMultiplier int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">
-    testMany TestType (0..*) <"Test many">
-    testSome TestSomeType (1..*) <"Test some">
-    testMaybeOne TestZeroOneType (0..1) <"Test zero or one">
-
-type TestTypeasd: <"description">
-    periodMultiplier int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">
-
-type TestSomeType: <"description">
-    periodMultiplier int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">
-
-type TestZeroOneType: <"description">
-    periodMultiplier int (1..1) <"A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.">

src/TestFiles/typeEnum.hs

@@ -1,13 +0,0 @@
-{-description-}
-data PeriodEnum =
-    {-Day-}
-    D
-    {-Month-}
-    | M
-    {-Year-}
-    | Y
-
-instance Show PeriodEnum where
-    show D = "day"
-    show M = "month"
-    show Y = "year"

src/TestFiles/typeTest.hs

@@ -1,11 +0,0 @@
-{-description-}
-data Period = MakePeriod {
-    {-A time period multiplier, e.g. 1, 2 or 3 etc. A negative value can be used when specifying an offset relative to another date, e.g. -2 days.-}
-    periodMultiplier :: int
-    {-Test many-}
-    testMany :: [TestType]
-    {-Test some-}
-    testSome :: [TestSomeType]
-    {-Test zero or one-}
-    testMaybeOne :: Maybe TestZeroOneType
-}