fixed cardinality of is statements

This commit is contained in:
Macocian Adrian Radu
2022-02-17 22:04:55 +01:00
parent 1ebc24140c
commit 8743dc0874
15 changed files with 210 additions and 100 deletions

1
.gitignore vendored
View File

@@ -23,3 +23,4 @@ cabal.project.local~
.ghc.environment.* .ghc.environment.*
.idea/ .idea/
/resources/Generated/ /resources/Generated/
.vscode/

View File

@@ -27,12 +27,14 @@ library
exposed-modules: exposed-modules:
Model.Enum Model.Enum
Model.Function Model.Function
Model.Header
Model.RosettaObject Model.RosettaObject
Model.Type Model.Type
Parser.Enum Parser.Enum
Parser.Expression Parser.Expression
Parser.Function Parser.Function
Parser.General Parser.General
Parser.Header
Parser.Type Parser.Type
PrettyPrinter.Enum PrettyPrinter.Enum
PrettyPrinter.Function PrettyPrinter.Function
@@ -76,6 +78,7 @@ test-suite RosettaParser-test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: Spec.hs main-is: Spec.hs
other-modules: other-modules:
Model.TypeSpec
Parser.EnumSpec Parser.EnumSpec
Parser.ExpressionSpec Parser.ExpressionSpec
Parser.TypeSpec Parser.TypeSpec

View File

@@ -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"

View File

@@ -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"

View File

@@ -1,7 +0,0 @@
data EnumWithoutDescription =
X
| Y
instance Show EnumWithoutDescription where
show X = "xs"
show Y = "ys"

View File

@@ -41,3 +41,11 @@ func Something: <"asd">
valuation ObservationPrimitive (0..*) valuation ObservationPrimitive (0..*)
assign-output: if True and False then valuationTime 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

9
src/Model/Header.hs Normal file
View File

@@ -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)

View File

@@ -50,6 +50,15 @@ instance Eq Cardinality where
(==) NoBounds NoBounds = True (==) NoBounds NoBounds = True
(==) _ _ = False (==) _ _ = 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 -- |A function used to add two cardinalities
addBounds :: Cardinality -> Cardinality -> Cardinality addBounds :: Cardinality -> Cardinality -> Cardinality
addBounds (Bounds (x1, x2)) (Bounds (y1, y2)) = Bounds (x1 + y1, x2 + y2) addBounds (Bounds (x1, x2)) (Bounds (y1, y2)) = Bounds (x1 + y1, x2 + y2)
@@ -69,3 +78,28 @@ infixl 5 .+
typeAndCardinality :: TypeAttribute -> (Type, Cardinality) typeAndCardinality :: TypeAttribute -> (Type, Cardinality)
typeAndCardinality (MakeTypeAttribute _ typ crd _) = (typ, crd) 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

View File

@@ -57,6 +57,9 @@ allowedChars = letterChar <|> digitChar <|> char '_'
-- |List of restricted names used by Rosetta -- |List of restricted names used by Rosetta
restrictedNames :: [String] restrictedNames :: [String]
restrictedNames = [ restrictedNames = [
"if",
"then",
"else",
"displayName", "displayName",
"enum", "enum",
"func", "func",

27
src/Parser/Header.hs Normal file
View File

@@ -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 '*')

View File

@@ -16,36 +16,47 @@ printFunction f = show $ vcat [printFunctionSignature f, printFunctionBody f, em
-- |Converts the body of a Function into a haskell valid Doc -- |Converts the body of a Function into a haskell valid Doc
printFunctionBody :: Function -> Doc a printFunctionBody :: Function -> Doc a
printFunctionBody (MakeFunction name _ inp _ ex) = pretty name <+> printVariableNames inp <+> "=" <+> printExpression ex printFunctionBody (MakeFunction name _ inp out ex) = pretty name <+> printVariableNames inp <+> "=" <+> printExpression inp (cardinality out) ex
printExpression :: Expression -> Doc a printExpression :: [TypeAttribute] -> Cardinality -> Expression -> Doc a
printExpression (Variable s) = pretty s printExpression inps c (Variable s) = printVariable varC c s
printExpression (Int s) = pretty s where
printExpression (Real s) = pretty s varC = getVarCardinality inps s
printExpression (Boolean s) = pretty s printExpression inps c (Int s) = printVariable (Bounds (1, 1)) c s
printExpression Empty = "empty" printExpression inps c (Real s) = printVariable (Bounds (1, 1)) c s
printExpression (Parens ex) = "(" <> printExpression ex <> ")" printExpression inps c (Boolean s) = printVariable (Bounds (1, 1)) c s
printExpression (List ex) = list (map printExpression ex) printExpression inps c Empty = "empty"
printExpression (Function name ex) = pretty name <> tupled (map printExpression ex) printExpression inps c (Parens ex) = "(" <> printExpression inps c ex <> ")"
printExpression (PrefixExp name ex) = pretty name <+> printExpression ex printExpression inps c (List ex) = list (map (printExpression inps c) ex)
printExpression (PostfixExp "exists" ex) = "isJust" <+> printExpression ex printExpression inps c (Function name ex) = pretty name <> tupled (map (printExpression inps c) ex)
printExpression (PostfixExp "is absent" ex) = "isNothing" <+> printExpression ex printExpression inps c (PrefixExp name ex) = pretty name <+> printExpression inps c ex
printExpression (PostfixExp "single exists" ex) = "length" <+> printExpression ex <+> "==" <+> "1" printExpression inps c (PostfixExp "exists" ex) = "isJust" <+> printExpression inps c ex
printExpression (PostfixExp "multiple exists" ex) = "length" <+> printExpression ex <+> ">" <+> "1" printExpression inps c (PostfixExp "is absent" ex) = "isNothing" <+> printExpression inps c ex
printExpression (PostfixExp "count" ex) = "length" <+> printExpression ex printExpression inps c (PostfixExp "single exists" ex) = "length" <+> printExpression inps c ex <+> "==" <+> "1"
printExpression (PostfixExp name ex) = pretty name <+> printExpression ex 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 -- Equality expressions
-- [a] a all = -- [a] a all =
-- any <> -- any <>
printExpression (InfixExp "=" ex1 ex2) = printExpression ex1 <+> "==" <+> printExpression ex2 printExpression inps c (InfixExp "=" ex1 ex2) = printExpression inps c ex1 <+> "==" <+> printExpression inps c ex2
printExpression (InfixExp "<>" ex1 ex2) = printExpression ex1 <+> "/=" <+> printExpression ex2 printExpression inps c (InfixExp "<>" ex1 ex2) = printExpression inps c ex1 <+> "/=" <+> printExpression inps c ex2
printExpression (InfixExp "any =" ex1 ex2) = printExpression ex2 <+> "`elem`" <+> printExpression ex1 printExpression inps c (InfixExp "any =" ex1 ex2) = printExpression inps c ex2 <+> "`elem`" <+> printExpression inps c ex1
printExpression (InfixExp "all <>" ex1 ex2) = printExpression ex2 <+> "`notElem`" <+> printExpression 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 "all =" ex1 ex2) = "all (Eq)" <+> printExpression ex2 <+> printExpression ex1
printExpression (InfixExp "and" ex1 ex2) = printExpression ex1 <+> "&&" <+> printExpression ex2 printExpression inps c (InfixExp "and" ex1 ex2) = printExpression inps c ex1 <+> "&&" <+> printExpression inps c ex2
printExpression (InfixExp "or" ex1 ex2) = printExpression ex1 <+> "||" <+> printExpression ex2 printExpression inps c (InfixExp "or" ex1 ex2) = printExpression inps c ex1 <+> "||" <+> printExpression inps c ex2
printExpression (InfixExp name ex1 ex2) = printExpression ex1 <+> pretty name <+> printExpression ex2 printExpression inps c (InfixExp name ex1 ex2) = printExpression inps c ex1 <+> pretty name <+> printExpression inps c ex2
printExpression (IfSimple cond ex) = "if" <+> printExpression cond <+> "then" <+> printExpression ex <+> "else" <+> "Nothing" 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 (IfElse cond ex1 ex2) = "if" <+> printExpression cond <+> "then" <+> printExpression ex1 <+> "else" <+> printExpression ex2 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 -- |Converts a list of type attributes to a Doc with a list of variable names
printVariableNames :: [TypeAttribute] -> Doc a printVariableNames :: [TypeAttribute] -> Doc a
@@ -59,3 +70,10 @@ printFunctionSignature (MakeFunction name description inputs output _) =
-- |Zips the signature with the needed characters ('::', '->') -- |Zips the signature with the needed characters ('::', '->')
prettyPrintType :: [Doc x] -> Doc x prettyPrintType :: [Doc x] -> Doc x
prettyPrintType = align . sep . Prelude.zipWith (<+>) ("::" : repeat "->") 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

View File

@@ -88,9 +88,7 @@ checkExpression symbolMap (InfixExp name ex1 ex2) = checkFunctionCall symbolMap
checkExpression symbolMap (IfSimple cond ex) checkExpression symbolMap (IfSimple cond ex)
| isRight condType && isSubType (fst $ fromRightUnsafe condType) (BasicType "Boolean") && snd (fromRightUnsafe condType) == Bounds (1, 1) = | isRight condType && isSubType (fst $ fromRightUnsafe condType) (BasicType "Boolean") && snd (fromRightUnsafe condType) == Bounds (1, 1) =
case checkedExp of 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)) Right (typ, Bounds(_, x)) -> Right (typ, Bounds(0, x))
-- |The unbounded or semi-bounded cardinalities already have 0 included
Right x -> Right x Right x -> Right x
Left err -> Left err Left err -> Left err
| otherwise = Left $ IfConditionNotBoolean $ show condType | otherwise = Left $ IfConditionNotBoolean $ show condType
@@ -101,7 +99,6 @@ checkExpression symbolMap (IfSimple cond ex)
checkExpression symbolMap (IfElse cond ex1 ex2) 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 condType || isSubType (fst $ fromRightUnsafe condType) (BasicType "Boolean") && snd (fromRightUnsafe condType) == Bounds (1, 1) = Left $ IfConditionNotBoolean $ show cond
| isLeft ex1Type || isLeft ex2Type || | isLeft ex1Type || isLeft ex2Type ||
-- |Both branches must resolve to the same type and cardinality
isLeft (typeMatch (fst $ fromRightUnsafe ex1Type) (fst $ fromRightUnsafe ex2Type)) || isLeft (typeMatch (fst $ fromRightUnsafe ex1Type) (fst $ fromRightUnsafe ex2Type)) ||
snd (fromRightUnsafe ex1Type) /= snd (fromRightUnsafe ex2Type) = Left $ IfExpressionsDifferentTypes (show ex1) (show ex2) snd (fromRightUnsafe ex1Type) /= snd (fromRightUnsafe ex2Type) = Left $ IfExpressionsDifferentTypes (show ex1) (show ex2)
| otherwise = ex1Type | otherwise = ex1Type
@@ -122,12 +119,13 @@ checkList1 :: [Symbol] -> [Expression] -> (Type, Cardinality) -> Either TypeChec
checkList1 _ [] typ = Right typ checkList1 _ [] typ = Right typ
checkList1 symbs (ex : exps) typ checkList1 symbs (ex : exps) typ
| isLeft exTyp = exTyp | isLeft exTyp = exTyp
| not match = Left $ TypeMismatch (typeName $ fst typ) (typeName $ fst (fromRightUnsafe exTyp)) | sub = checkList1 symbs exps (fst typ, smallestBound (snd $ fromRightUnsafe exTyp) (snd typ))
| otherwise = checkList1 symbs exps (fst typ, crd) | sup = checkList1 symbs exps (fst $ fromRightUnsafe exTyp, smallestBound (snd $ fromRightUnsafe exTyp) (snd typ))
| otherwise = Left $ TypeMismatch (typeName $ fst typ) (typeName $ fst (fromRightUnsafe exTyp))
where where
exTyp = checkExpression symbs ex exTyp = checkExpression symbs ex
match = fst typ == fst (fromRightUnsafe exTyp) sub = isSubType (fst typ) (fst (fromRightUnsafe exTyp))
crd = snd typ .+ snd (fromRightUnsafe exTyp) sup = isSubType (fst (fromRightUnsafe exTyp)) (fst typ)
-- |Checks whether the function that is called is already defined with the same argument types -- |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) 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 :: (Type, Cardinality) -> (Type, Cardinality) -> Either TypeCheckError Bool
typeIncluded (t1, c1) (t2, c2) typeIncluded (t1, c1) (t2, c2)
| isSubType t1 t2 && cardinalityIncluded c1 c2 = Right True | t1 `isSubType` t2 && cardinalityIncluded c1 c2 = Right True
| isSubType t1 t2 = Left $ CardinalityMismatch c1 c2 | t1 `isSubType` t2 = Left $ CardinalityMismatch c1 c2
| otherwise = Left $ TypeMismatch (typeName t1) (typeName t2) | 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 typeMatch :: Type -> Type -> Either TypeCheckError Type
-- |An object matches only with object -- |An object matches only with object
typeMatch (BasicType "Object") _ = Right $ BasicType "Object" typeMatch (BasicType "Object") _ = Right $ BasicType "Object"
@@ -164,30 +162,6 @@ typeMatch x y
| otherwise = typeMatch (superType x) y | otherwise = typeMatch (superType x) y
where match = typeMatch x (superType 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 -- |Looks in the symbol map for the type of a variable
findVarType :: String -> [Symbol] -> Either TypeCheckError (Type, Cardinality) findVarType :: String -> [Symbol] -> Either TypeCheckError (Type, Cardinality)
findVarType var [] = Left $ UndefinedVariable var findVarType var [] = Left $ UndefinedVariable var

View File

@@ -11,7 +11,7 @@ import Data.Char
checkFunction :: ([Type], [Symbol]) -> Function -> Either [TypeCheckError] Function checkFunction :: ([Type], [Symbol]) -> Function -> Either [TypeCheckError] Function
checkFunction (definedTypes, symbols) (MakeFunction name desc inp out ex) checkFunction (definedTypes, symbols) (MakeFunction name desc inp out ex)
| isRight checkedEx && isRight checkedOut && null (lefts checkedIn) = | 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 Right _ -> Right $ MakeFunction (toLower (head name) : tail name) desc (rights checkedIn) (fromRightUnsafe checkedOut) ex
Left err -> Left [err] Left err -> Left [err]
| otherwise = Left $ lefts [checkedOut] ++ lefts checkedIn ++ lefts [checkedEx] | otherwise = Left $ lefts [checkedOut] ++ lefts checkedIn ++ lefts [checkedEx]

View File

@@ -28,10 +28,10 @@ checkType _ (BasicType b) = Right (BasicType b)
populateSuper :: [Type] -> [Type] -> Type -> Either TypeCheckError Type populateSuper :: [Type] -> [Type] -> Type -> Either TypeCheckError Type
populateSuper _ _ (BasicType "Object") = Right (BasicType "Object") populateSuper _ _ (BasicType "Object") = Right (BasicType "Object")
populateSuper _ _ (BasicType _) = Left $ UndefinedType "Can't extend basic types" 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) populateSuper allTypes (currType : types) (MakeType t super d a)
| typeName currType == typeName super = case populateSuper allTypes allTypes currType of | typeName currType == t = case populateSuper allTypes allTypes super of
Right superChecked -> Right $ MakeType t superChecked d a Right superChecked -> Right $ MakeType t superChecked (typeDescription currType) (typeAttributes currType)
Left err -> Left err Left err -> Left err
| otherwise = populateSuper allTypes types (MakeType t super d a) | otherwise = populateSuper allTypes types (MakeType t super d a)

66
test/Model/TypeSpec.hs Normal file
View File

@@ -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]