diff --git a/.gitignore b/.gitignore index 9e2fa7e..b5c99b8 100644 --- a/.gitignore +++ b/.gitignore @@ -23,3 +23,4 @@ cabal.project.local~ .ghc.environment.* .idea/ /resources/Generated/ +.vscode/ diff --git a/RosettaParser.cabal b/RosettaParser.cabal index dd53c80..4be877a 100644 --- a/RosettaParser.cabal +++ b/RosettaParser.cabal @@ -27,12 +27,14 @@ library exposed-modules: Model.Enum Model.Function + Model.Header Model.RosettaObject Model.Type Parser.Enum Parser.Expression Parser.Function Parser.General + Parser.Header Parser.Type PrettyPrinter.Enum PrettyPrinter.Function @@ -76,6 +78,7 @@ test-suite RosettaParser-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + Model.TypeSpec Parser.EnumSpec Parser.ExpressionSpec Parser.TypeSpec diff --git a/resources/Enums/haskellEnum1.hs b/resources/Enums/haskellEnum1.hs deleted file mode 100644 index f8aa4b3..0000000 --- a/resources/Enums/haskellEnum1.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-The enumerated values to specified the period, e.g. day, week.-} -data PeriodEnum = - {-Day-} - D - {-Month-} - | M - {-Year-} - | Y - -instance Show PeriodEnum where - show D = "day" - show M = "month" - show Y = "year" diff --git a/resources/Enums/haskellEnum2.hs b/resources/Enums/haskellEnum2.hs deleted file mode 100644 index dca845a..0000000 --- a/resources/Enums/haskellEnum2.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-The enumerated values to specified the period, e.g. day, week.-} -data EnumWithoutDisplay = - {-Day-} - D - {-Month-} - | M - {-Year-} - | Y - -instance Show EnumWithoutDisplay where - show D = "D" - show M = "M" - show Y = "Y" diff --git a/resources/Enums/haskellEnum3.hs b/resources/Enums/haskellEnum3.hs deleted file mode 100644 index 8a5d33a..0000000 --- a/resources/Enums/haskellEnum3.hs +++ /dev/null @@ -1,7 +0,0 @@ -data EnumWithoutDescription = - X - | Y - -instance Show EnumWithoutDescription where - show X = "xs" - show Y = "ys" diff --git a/resources/testAll.rosetta b/resources/testAll.rosetta index 8a63a41..29c327b 100644 --- a/resources/testAll.rosetta +++ b/resources/testAll.rosetta @@ -38,6 +38,14 @@ func Something: <"asd"> equity1 boolean (1..1) valuationTime ObservationPrimitive (1..1) output: - valuation ObservationPrimitive (0..*) + valuation ObservationPrimitive (0..*) + + assign-output: if True and False then valuationTime + +func SomethingElse: <"dsa"> + inputs: + valuationTime ObservationPrimitive (1..1) + output: + valuation ObservationPrimitive (0..1) assign-output: if True and False then valuationTime \ No newline at end of file diff --git a/src/Model/Header.hs b/src/Model/Header.hs new file mode 100644 index 0000000..cea65ae --- /dev/null +++ b/src/Model/Header.hs @@ -0,0 +1,9 @@ +module Model.Header where + +-- |Representation of the information stored in the file header +data Header = MakeHeader { + namespace :: String, + headerDescription :: Maybe String, + version :: String, + imports :: [String] +} deriving (Show, Eq) \ No newline at end of file diff --git a/src/Model/Type.hs b/src/Model/Type.hs index 55f934e..b52b4c2 100644 --- a/src/Model/Type.hs +++ b/src/Model/Type.hs @@ -50,6 +50,15 @@ instance Eq Cardinality where (==) NoBounds NoBounds = True (==) _ _ = False +-- |Function to create the smallest cardinality that includes two others +smallestBound :: Cardinality -> Cardinality -> Cardinality +smallestBound NoBounds _ = NoBounds +smallestBound _ NoBounds = NoBounds +smallestBound (OneBound x) (OneBound y) = OneBound $ min x y +smallestBound (OneBound x) (Bounds (y, _)) = smallestBound (OneBound x) (OneBound y) +smallestBound (Bounds (x, _)) (OneBound y) = smallestBound (OneBound x) (OneBound y) +smallestBound (Bounds (x1, x2)) (Bounds (y1, y2)) = Bounds (min x1 y1, max x2 y2) + -- |A function used to add two cardinalities addBounds :: Cardinality -> Cardinality -> Cardinality addBounds (Bounds (x1, x2)) (Bounds (y1, y2)) = Bounds (x1 + y1, x2 + y2) @@ -68,4 +77,29 @@ infixl 5 .+ (.+) = addBounds typeAndCardinality :: TypeAttribute -> (Type, Cardinality) -typeAndCardinality (MakeTypeAttribute _ typ crd _) = (typ, crd) \ No newline at end of file +typeAndCardinality (MakeTypeAttribute _ typ crd _) = (typ, crd) + + +-- |Checks whether the first argument is a subtype of the second argument +isSubType :: Type -> Type -> Bool +isSubType (BasicType "Integer") (BasicType "Double") = True +isSubType _ (BasicType "Any") = True +isSubType _ (BasicType "Object") = False +isSubType x y + | x == y = True + | otherwise = isSubType (superType x) y + +-- |Checks whether the first cardinality is included into the second one +cardinalityIncluded :: Cardinality -> Cardinality -> Bool +cardinalityIncluded _ NoBounds = True +cardinalityIncluded NoBounds _ = False +cardinalityIncluded (OneBound x) (OneBound y) + | x >= y = True + | otherwise = False +cardinalityIncluded (Bounds (x1, _)) (OneBound y) + | x1 >= y = True + | otherwise = False +cardinalityIncluded (OneBound _) (Bounds (_, _)) = False +cardinalityIncluded (Bounds (x1, x2)) (Bounds (y1, y2)) + | x1 >= y1 && x2 <= y2 = True + | otherwise = False \ No newline at end of file diff --git a/src/Parser/General.hs b/src/Parser/General.hs index ee32f36..ee69732 100755 --- a/src/Parser/General.hs +++ b/src/Parser/General.hs @@ -57,6 +57,9 @@ allowedChars = letterChar <|> digitChar <|> char '_' -- |List of restricted names used by Rosetta restrictedNames :: [String] restrictedNames = [ + "if", + "then", + "else", "displayName", "enum", "func", diff --git a/src/Parser/Header.hs b/src/Parser/Header.hs new file mode 100644 index 0000000..dd930bc --- /dev/null +++ b/src/Parser/Header.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Parser.Header where + +import Model.Header +import Parser.General +import Text.Megaparsec +import Text.Megaparsec.Char +import Text.ParserCombinators.ReadP (many1) + +headerParser :: Parser Header +headerParser = do + _ <- lexeme $ string "namespace" + name <- namespaceParser + desc <- optional descriptionParser + _ <- lexeme $ string "version" + vers <- between (char '\"') (char '\"') (many (letterChar <|> char '.' <|> char '$' <|> digitChar)) + imports <- many importParser + return $ MakeHeader name desc vers imports + +importParser :: Parser String +importParser = do + _ <- lexeme $ string "import" + namespaceParser + +namespaceParser :: Parser String +namespaceParser = many (letterChar <|> digitChar <|> char '.' <|> char '*') \ No newline at end of file diff --git a/src/PrettyPrinter/Function.hs b/src/PrettyPrinter/Function.hs index 2e90b3d..44fd942 100644 --- a/src/PrettyPrinter/Function.hs +++ b/src/PrettyPrinter/Function.hs @@ -16,36 +16,47 @@ printFunction f = show $ vcat [printFunctionSignature f, printFunctionBody f, em -- |Converts the body of a Function into a haskell valid Doc printFunctionBody :: Function -> Doc a -printFunctionBody (MakeFunction name _ inp _ ex) = pretty name <+> printVariableNames inp <+> "=" <+> printExpression ex -printExpression :: Expression -> Doc a -printExpression (Variable s) = pretty s -printExpression (Int s) = pretty s -printExpression (Real s) = pretty s -printExpression (Boolean s) = pretty s -printExpression Empty = "empty" -printExpression (Parens ex) = "(" <> printExpression ex <> ")" -printExpression (List ex) = list (map printExpression ex) -printExpression (Function name ex) = pretty name <> tupled (map printExpression ex) -printExpression (PrefixExp name ex) = pretty name <+> printExpression ex -printExpression (PostfixExp "exists" ex) = "isJust" <+> printExpression ex -printExpression (PostfixExp "is absent" ex) = "isNothing" <+> printExpression ex -printExpression (PostfixExp "single exists" ex) = "length" <+> printExpression ex <+> "==" <+> "1" -printExpression (PostfixExp "multiple exists" ex) = "length" <+> printExpression ex <+> ">" <+> "1" -printExpression (PostfixExp "count" ex) = "length" <+> printExpression ex -printExpression (PostfixExp name ex) = pretty name <+> printExpression ex +printFunctionBody (MakeFunction name _ inp out ex) = pretty name <+> printVariableNames inp <+> "=" <+> printExpression inp (cardinality out) ex +printExpression :: [TypeAttribute] -> Cardinality -> Expression -> Doc a +printExpression inps c (Variable s) = printVariable varC c s + where + varC = getVarCardinality inps s +printExpression inps c (Int s) = printVariable (Bounds (1, 1)) c s +printExpression inps c (Real s) = printVariable (Bounds (1, 1)) c s +printExpression inps c (Boolean s) = printVariable (Bounds (1, 1)) c s +printExpression inps c Empty = "empty" +printExpression inps c (Parens ex) = "(" <> printExpression inps c ex <> ")" +printExpression inps c (List ex) = list (map (printExpression inps c) ex) +printExpression inps c (Function name ex) = pretty name <> tupled (map (printExpression inps c) ex) +printExpression inps c (PrefixExp name ex) = pretty name <+> printExpression inps c ex +printExpression inps c (PostfixExp "exists" ex) = "isJust" <+> printExpression inps c ex +printExpression inps c (PostfixExp "is absent" ex) = "isNothing" <+> printExpression inps c ex +printExpression inps c (PostfixExp "single exists" ex) = "length" <+> printExpression inps c ex <+> "==" <+> "1" +printExpression inps c (PostfixExp "multiple exists" ex) = "length" <+> printExpression inps c ex <+> ">" <+> "1" +printExpression inps c (PostfixExp "count" ex) = "length" <+> printExpression inps c ex +printExpression inps c (PostfixExp name ex) = pretty name <+> printExpression inps c ex -- Equality expressions -- [a] a all = -- any <> -printExpression (InfixExp "=" ex1 ex2) = printExpression ex1 <+> "==" <+> printExpression ex2 -printExpression (InfixExp "<>" ex1 ex2) = printExpression ex1 <+> "/=" <+> printExpression ex2 -printExpression (InfixExp "any =" ex1 ex2) = printExpression ex2 <+> "`elem`" <+> printExpression ex1 -printExpression (InfixExp "all <>" ex1 ex2) = printExpression ex2 <+> "`notElem`" <+> printExpression ex1 +printExpression inps c (InfixExp "=" ex1 ex2) = printExpression inps c ex1 <+> "==" <+> printExpression inps c ex2 +printExpression inps c (InfixExp "<>" ex1 ex2) = printExpression inps c ex1 <+> "/=" <+> printExpression inps c ex2 +printExpression inps c (InfixExp "any =" ex1 ex2) = printExpression inps c ex2 <+> "`elem`" <+> printExpression inps c ex1 +printExpression inps c (InfixExp "all <>" ex1 ex2) = printExpression inps c ex2 <+> "`notElem`" <+> printExpression inps c ex1 --printExpression (InfixExp "all =" ex1 ex2) = "all (Eq)" <+> printExpression ex2 <+> printExpression ex1 -printExpression (InfixExp "and" ex1 ex2) = printExpression ex1 <+> "&&" <+> printExpression ex2 -printExpression (InfixExp "or" ex1 ex2) = printExpression ex1 <+> "||" <+> printExpression ex2 -printExpression (InfixExp name ex1 ex2) = printExpression ex1 <+> pretty name <+> printExpression ex2 -printExpression (IfSimple cond ex) = "if" <+> printExpression cond <+> "then" <+> printExpression ex <+> "else" <+> "Nothing" -printExpression (IfElse cond ex1 ex2) = "if" <+> printExpression cond <+> "then" <+> printExpression ex1 <+> "else" <+> printExpression ex2 +printExpression inps c (InfixExp "and" ex1 ex2) = printExpression inps c ex1 <+> "&&" <+> printExpression inps c ex2 +printExpression inps c (InfixExp "or" ex1 ex2) = printExpression inps c ex1 <+> "||" <+> printExpression inps c ex2 +printExpression inps c (InfixExp name ex1 ex2) = printExpression inps c ex1 <+> pretty name <+> printExpression inps c ex2 +printExpression inps (Bounds (0, 1)) (IfSimple cond ex) = "if" <+> printExpression inps (Bounds (1, 1)) cond <+> "then" <+> printExpression inps (Bounds (0, 1)) ex <+> "else" <+> "Nothing" +printExpression inps c (IfSimple cond ex) = "if" <+> printExpression inps (Bounds (1, 1)) cond <+> "then" <+> printExpression inps c ex <+> "else" <+> "[]" +printExpression inps c (IfElse cond ex1 ex2) = "if" <+> printExpression inps (Bounds (1, 1)) cond <+> "then" <+> printExpression inps c ex1 <+> "else" <+> printExpression inps c ex2 + +-- |Converts a variable into a maybe or list depending on necessity +printVariable :: Cardinality -> Cardinality -> String -> Doc a +printVariable (Bounds (1, 1)) (Bounds (1, 1)) s = pretty s +printVariable (Bounds (1, 1)) (Bounds (0, 1)) s = "Just" <+> pretty s +printVariable (Bounds (0, 1)) (Bounds (0, 1)) s = pretty s +printVariable (Bounds (1, 1)) _ s = "[" <+> pretty s <+> "]" +printVariable _ _ s = pretty s -- |Converts a list of type attributes to a Doc with a list of variable names printVariableNames :: [TypeAttribute] -> Doc a @@ -58,4 +69,11 @@ printFunctionSignature (MakeFunction name description inputs output _) = -- |Zips the signature with the needed characters ('::', '->') prettyPrintType :: [Doc x] -> Doc x -prettyPrintType = align . sep . Prelude.zipWith (<+>) ("::" : repeat "->") \ No newline at end of file +prettyPrintType = align . sep . Prelude.zipWith (<+>) ("::" : repeat "->") + +-- |Gets the cardinality of a variable by name +getVarCardinality :: [TypeAttribute] -> String -> Cardinality +getVarCardinality [] _ = error "Variable not a parameter" +getVarCardinality (MakeTypeAttribute name _ card _ : inps) varName + | name == varName = card + | otherwise = getVarCardinality inps varName \ No newline at end of file diff --git a/src/Semantic/ExpressionChecker.hs b/src/Semantic/ExpressionChecker.hs index d62077c..ff7d2ef 100644 --- a/src/Semantic/ExpressionChecker.hs +++ b/src/Semantic/ExpressionChecker.hs @@ -88,9 +88,7 @@ checkExpression symbolMap (InfixExp name ex1 ex2) = checkFunctionCall symbolMap checkExpression symbolMap (IfSimple cond ex) | isRight condType && isSubType (fst $ fromRightUnsafe condType) (BasicType "Boolean") && snd (fromRightUnsafe condType) == Bounds (1, 1) = case checkedExp of - -- |The if without else statement always has a cardinality lower bound of 0 Right (typ, Bounds(_, x)) -> Right (typ, Bounds(0, x)) - -- |The unbounded or semi-bounded cardinalities already have 0 included Right x -> Right x Left err -> Left err | otherwise = Left $ IfConditionNotBoolean $ show condType @@ -101,7 +99,6 @@ checkExpression symbolMap (IfSimple cond ex) checkExpression symbolMap (IfElse cond ex1 ex2) | isLeft condType || isSubType (fst $ fromRightUnsafe condType) (BasicType "Boolean") && snd (fromRightUnsafe condType) == Bounds (1, 1) = Left $ IfConditionNotBoolean $ show cond | isLeft ex1Type || isLeft ex2Type || - -- |Both branches must resolve to the same type and cardinality isLeft (typeMatch (fst $ fromRightUnsafe ex1Type) (fst $ fromRightUnsafe ex2Type)) || snd (fromRightUnsafe ex1Type) /= snd (fromRightUnsafe ex2Type) = Left $ IfExpressionsDifferentTypes (show ex1) (show ex2) | otherwise = ex1Type @@ -122,12 +119,13 @@ checkList1 :: [Symbol] -> [Expression] -> (Type, Cardinality) -> Either TypeChec checkList1 _ [] typ = Right typ checkList1 symbs (ex : exps) typ | isLeft exTyp = exTyp - | not match = Left $ TypeMismatch (typeName $ fst typ) (typeName $ fst (fromRightUnsafe exTyp)) - | otherwise = checkList1 symbs exps (fst typ, crd) + | sub = checkList1 symbs exps (fst typ, smallestBound (snd $ fromRightUnsafe exTyp) (snd typ)) + | sup = checkList1 symbs exps (fst $ fromRightUnsafe exTyp, smallestBound (snd $ fromRightUnsafe exTyp) (snd typ)) + | otherwise = Left $ TypeMismatch (typeName $ fst typ) (typeName $ fst (fromRightUnsafe exTyp)) where exTyp = checkExpression symbs ex - match = fst typ == fst (fromRightUnsafe exTyp) - crd = snd typ .+ snd (fromRightUnsafe exTyp) + sub = isSubType (fst typ) (fst (fromRightUnsafe exTyp)) + sup = isSubType (fst (fromRightUnsafe exTyp)) (fst typ) -- |Checks whether the function that is called is already defined with the same argument types checkFunctionCall :: [Symbol] -> String -> [Either TypeCheckError (Type, Cardinality)] -> Either TypeCheckError (Type, Cardinality) @@ -142,11 +140,11 @@ checkFunctionCall (_:symbolMap) name args = checkFunctionCall symbolMap name arg typeIncluded :: (Type, Cardinality) -> (Type, Cardinality) -> Either TypeCheckError Bool typeIncluded (t1, c1) (t2, c2) - | isSubType t1 t2 && cardinalityIncluded c1 c2 = Right True - | isSubType t1 t2 = Left $ CardinalityMismatch c1 c2 + | t1 `isSubType` t2 && cardinalityIncluded c1 c2 = Right True + | t1 `isSubType` t2 = Left $ CardinalityMismatch c1 c2 | otherwise = Left $ TypeMismatch (typeName t1) (typeName t2) --- |Checks whether two types are compatible +-- |Checks whether two types are compatible (i.e. they have a common super type) typeMatch :: Type -> Type -> Either TypeCheckError Type -- |An object matches only with object typeMatch (BasicType "Object") _ = Right $ BasicType "Object" @@ -163,30 +161,6 @@ typeMatch x y | isRight match = Right $ fromRightUnsafe match | otherwise = typeMatch (superType x) y where match = typeMatch x (superType y) - --- |Checks whether the first argument is a subtype of the second argument -isSubType :: Type -> Type -> Bool -isSubType (BasicType "Integer") (BasicType "Double") = True -isSubType _ (BasicType "Any") = True -isSubType _ (BasicType "Object") = False -isSubType x y - | x == y = True - | otherwise = isSubType (superType x) y - --- |Checks whether the first cardinality is included into the second one -cardinalityIncluded :: Cardinality -> Cardinality -> Bool -cardinalityIncluded _ NoBounds = True -cardinalityIncluded NoBounds _ = False -cardinalityIncluded (OneBound x) (OneBound y) - | x >= y = True - | otherwise = False -cardinalityIncluded (Bounds (x1, _)) (OneBound y) - | x1 >= y = True - | otherwise = False -cardinalityIncluded (OneBound _) (Bounds (_, _)) = False -cardinalityIncluded (Bounds (x1, x2)) (Bounds (y1, y2)) - | x1 >= y1 && x2 <= y2 = True - | otherwise = False -- |Looks in the symbol map for the type of a variable findVarType :: String -> [Symbol] -> Either TypeCheckError (Type, Cardinality) diff --git a/src/Semantic/FunctionChecker.hs b/src/Semantic/FunctionChecker.hs index 0bce0bb..da3c20f 100644 --- a/src/Semantic/FunctionChecker.hs +++ b/src/Semantic/FunctionChecker.hs @@ -11,7 +11,7 @@ import Data.Char checkFunction :: ([Type], [Symbol]) -> Function -> Either [TypeCheckError] Function checkFunction (definedTypes, symbols) (MakeFunction name desc inp out ex) | isRight checkedEx && isRight checkedOut && null (lefts checkedIn) = - case typeIncluded (attributeType $ fromRightUnsafe checkedOut, Model.Type.cardinality out) (fromRightUnsafe checkedEx) of + case typeIncluded (fromRightUnsafe checkedEx) (attributeType $ fromRightUnsafe checkedOut, Model.Type.cardinality out) of Right _ -> Right $ MakeFunction (toLower (head name) : tail name) desc (rights checkedIn) (fromRightUnsafe checkedOut) ex Left err -> Left [err] | otherwise = Left $ lefts [checkedOut] ++ lefts checkedIn ++ lefts [checkedEx] diff --git a/src/Semantic/TypeChecker.hs b/src/Semantic/TypeChecker.hs index 634094d..a11a42a 100644 --- a/src/Semantic/TypeChecker.hs +++ b/src/Semantic/TypeChecker.hs @@ -28,10 +28,10 @@ checkType _ (BasicType b) = Right (BasicType b) populateSuper :: [Type] -> [Type] -> Type -> Either TypeCheckError Type populateSuper _ _ (BasicType "Object") = Right (BasicType "Object") populateSuper _ _ (BasicType _) = Left $ UndefinedType "Can't extend basic types" -populateSuper _ [] t = Left $ UndefinedType (typeName t) +populateSuper _ [] t = error "WTF" --Left $ UndefinedType (typeName t) populateSuper allTypes (currType : types) (MakeType t super d a) - | typeName currType == typeName super = case populateSuper allTypes allTypes currType of - Right superChecked -> Right $ MakeType t superChecked d a + | typeName currType == t = case populateSuper allTypes allTypes super of + Right superChecked -> Right $ MakeType t superChecked (typeDescription currType) (typeAttributes currType) Left err -> Left err | otherwise = populateSuper allTypes types (MakeType t super d a) diff --git a/test/Model/TypeSpec.hs b/test/Model/TypeSpec.hs new file mode 100644 index 0000000..da8863b --- /dev/null +++ b/test/Model/TypeSpec.hs @@ -0,0 +1,66 @@ +module Model.TypeSpec where + +import Test.Hspec +import Model.Type + +spec :: Spec +spec = do + describe "Testing cardinality addition" $ do + it "[Test add 1]" $ do + head cards1 .+ head cards2 `shouldBe` head cardsSum + it "[Test add 2]" $ do + cards1 !! 1 .+ cards2 !! 1 `shouldBe` cardsSum !! 1 + it "[Test add 3]" $ do + cards1 !! 2 .+ cards2 !! 2 `shouldBe` cardsSum !! 2 + it "[Test add 4]" $ do + cards1 !! 3 .+ cards2 !! 3 `shouldBe` cardsSum !! 3 + it "[Test add 5]" $ do + cards1 !! 4 .+ cards2 !! 4 `shouldBe` cardsSum !! 4 + it "[Test add 6]" $ do + cards1 !! 5 .+ cards2 !! 5 `shouldBe` cardsSum !! 5 + it "[Test add 7]" $ do + cards1 !! 6 .+ cards2 !! 6 `shouldBe` cardsSum !! 6 + it "[Test add 8]" $ do + cards1 !! 7 .+ cards2 !! 7 `shouldBe` cardsSum !! 7 + it "[Test add 9]" $ do + cards1 !! 8 .+ cards2 !! 8 `shouldBe` cardsSum !! 8 + it "[Test add 10]" $ do + cards1 !! 9 .+ cards2 !! 9 `shouldBe` cardsSum !! 9 + describe "Testing smallest cardinality" $ do + it "[Test smallest 1]" $ do + smallestBound (head cards1) (head cards2) `shouldBe` head smallestCards + it "[Test smallest 2]" $ do + smallestBound (cards1 !! 1) (cards2 !! 1) `shouldBe` smallestCards !! 1 + it "[Test smallest 3]" $ do + smallestBound (cards1 !! 2) (cards2 !! 2) `shouldBe` smallestCards !! 2 + it "[Test smallest 4]" $ do + smallestBound (cards1 !! 3) (cards2 !! 3) `shouldBe` smallestCards !! 3 + it "[Test smallest 5]" $ do + smallestBound (cards1 !! 4) (cards2 !! 4) `shouldBe` smallestCards !! 4 + it "[Test smallest 6]" $ do + smallestBound (cards1 !! 5) (cards2 !! 5) `shouldBe` smallestCards !! 5 + it "[Test smallest 7]" $ do + smallestBound (cards1 !! 6) (cards2 !! 6) `shouldBe` smallestCards !! 6 + it "[Test smallest 8]" $ do + smallestBound (cards1 !! 7) (cards2 !! 7) `shouldBe` smallestCards !! 7 + it "[Test smallest 9]" $ do + smallestBound (cards1 !! 8) (cards2 !! 8) `shouldBe` smallestCards !! 8 + it "[Test smallest 10]" $ do + smallestBound (cards1 !! 9) (cards2 !! 9) `shouldBe` smallestCards !! 9 + + +cards1 :: [Cardinality] +cards1 = + [Bounds (0, 20), Bounds (10, 15), Bounds (25, 50), Bounds (15, 16), NoBounds, OneBound 25, OneBound 2, OneBound 1, NoBounds, NoBounds] + +cards2 :: [Cardinality] +cards2 = + [Bounds (2, 4), Bounds (4, 45), OneBound 6, NoBounds, Bounds (2, 5), Bounds (2, 30), OneBound 5, NoBounds, OneBound 5, NoBounds] + +cardsSum :: [Cardinality] +cardsSum = + [Bounds (2, 24), Bounds (14, 60), OneBound 31, OneBound 15, OneBound 2, OneBound 27, OneBound 7, OneBound 1, OneBound 5, NoBounds] + +smallestCards :: [Cardinality] +smallestCards = + [Bounds (0, 20), Bounds (4, 45), OneBound 6, NoBounds, NoBounds, OneBound 2, OneBound 2, NoBounds, NoBounds, NoBounds] \ No newline at end of file