From b9579046bab737deee0831ca410df125b053cec3 Mon Sep 17 00:00:00 2001 From: polsevev Date: Sun, 7 May 2023 11:05:21 +0200 Subject: [PATCH] finished --- src/Algorithm/BaseQuery.hs | 4 +++- src/Algorithm/Lex.hs | 25 ++++++++++++++++--------- src/Algorithm/Operator.hs | 6 +++--- src/Algorithm/Search.hs | 7 ++++--- 4 files changed, 26 insertions(+), 16 deletions(-) diff --git a/src/Algorithm/BaseQuery.hs b/src/Algorithm/BaseQuery.hs index 9005940..9112103 100644 --- a/src/Algorithm/BaseQuery.hs +++ b/src/Algorithm/BaseQuery.hs @@ -9,7 +9,8 @@ module Algorithm.BaseQuery CardFace(..), ImageUris(..), isLegal, - notSuperType + notSuperType, + color ) where import qualified Data.Text as T import Database.SQLite.Simple @@ -192,4 +193,5 @@ isLegal qry = do cards <- fetchCardsWithIds res return $ Holder cards +color :: String -> IO Tree diff --git a/src/Algorithm/Lex.hs b/src/Algorithm/Lex.hs index ce55817..85d929a 100644 --- a/src/Algorithm/Lex.hs +++ b/src/Algorithm/Lex.hs @@ -87,7 +87,7 @@ data QueryDef = CMCLT Int | CMCMT Int | CMCEQ Int | - IsLegal String + IsLegal String deriving Show data Operator = Union | @@ -105,7 +105,7 @@ seperator ("(":rest) ((start,end):points) = case drop (end-start) rest of a -> Left $ ParseError $ "Could not parse input, error happened at: " ++ (show (concat a)) seperator [name, " ", value, ")"] _ = case extractQueryDef (name, value) of Left a -> Left a - Right b -> Right $ Queri $ b + Right b -> Right $ b seperator a _ = Left (ParseError ("Something went wrong tokenizing the input!\n" ++ (show a))) spawnBranch :: Operator -> (Either ParseError Token) -> (Either ParseError Token) -> (Either ParseError Token) @@ -116,19 +116,26 @@ spawnBranch operator (Right res1) (Right res2) = Right (Func operator res1 res2) -extractQueryDef :: (String, String) -> Either ParseError QueryDef -extractQueryDef ("SuperType", value) = Right $ SuperType value -extractQueryDef ("NotSuperType", value) = Right $ NotSuperType value +extractQueryDef :: (String, String) -> Either ParseError Token +extractQueryDef ("SuperType", value) = Right $ Queri $ SuperType value +extractQueryDef ("NotSuperType", value) = Right $ Queri $ NotSuperType value extractQueryDef ("CmcLT", value) = case readMaybe value :: Maybe Int of - Just a -> Right $ CMCLT a + Just a -> Right $ Queri $ CMCLT a Nothing -> Left $ ParseError "Could not parse number from call to CmcLT" extractQueryDef ("CmcMT", value) = case readMaybe value :: Maybe Int of - Just a -> Right $ CMCMT a + Just a -> Right $ Queri $ CMCMT a Nothing -> Left $ ParseError "Could not parse number from call to CmcMT" extractQueryDef ("CmcEQ", value) = case readMaybe value :: Maybe Int of - Just a -> Right $ CMCEQ a + Just a -> Right $ Queri $ CMCEQ a Nothing -> Left $ ParseError "Could not parse number from call to CmcEQ" -extractQueryDef ("IsLegal", value) = Right $ IsLegal value +extractQueryDef ("CmcLTEQ", value) = case readMaybe value :: Maybe Int of + Just a -> Right $ Func Union (Queri $ CMCLT a) (Queri $ CMCEQ a) + Nothing -> Left $ ParseError "Could not parse number from call to CmcLTEQ" +extractQueryDef ("CmcMTEQ", value) = case readMaybe value :: Maybe Int of + Just a -> Right $ Func Union (Queri $ CMCMT a) (Queri $ CMCEQ a) + Nothing -> Left $ ParseError "Could not parse number from call to CmcLTEQ" +extractQueryDef ("Color", value) = Right $ Queri $ Color value +extractQueryDef ("IsLegal", value) = Right $ Queri $ IsLegal value extractQueryDef (a,b) = Left $ ParseError $ "The following command is invalid " ++ show a extractOperator "union" = Union diff --git a/src/Algorithm/Operator.hs b/src/Algorithm/Operator.hs index ab81bc2..91d9201 100644 --- a/src/Algorithm/Operator.hs +++ b/src/Algorithm/Operator.hs @@ -7,9 +7,9 @@ module Algorithm.Operator union :: Eq a => [a] -> [a] -> [a] -union (a:as) bs | a `elem` bs = union as bs -union (a:as) bs = a : union as bs -union [] _ = [] +union (a:as) bs | a `notElem` bs =a : union as bs +union (a:as) bs = union as bs +union [] bs = bs intersect :: Eq a => [a] -> [a] -> [a] intersect (a:as) b = if a `elem` b then a: intersect as b else intersect as b diff --git a/src/Algorithm/Search.hs b/src/Algorithm/Search.hs index 267930d..5abc926 100644 --- a/src/Algorithm/Search.hs +++ b/src/Algorithm/Search.hs @@ -26,7 +26,7 @@ search q = do tree <- executeBottomQuery tokens let queryRes = executeQuery tree let hyperText = buildHtml queryRes - return hyperText + return $ "
" ++ hyperText ++ "
" --In order to avoid IO when performing the operators, we fetch all the "bottom" queries first, then perform --the operators on them based on the Tree @@ -53,6 +53,7 @@ executeBottomQuery (Queri (CMCLT value)) = cmcLT value executeBottomQuery (Queri (CMCMT value)) = cmcMT value executeBottomQuery (Queri (CMCEQ value)) = cmcEQ value executeBottomQuery (Queri (IsLegal value)) | map toLower value `elem` formats = isLegal $ map toLower value +executeBottomQuery (Queri (Color value)) = color value executeBottomQuery (Queri _) = error $ "Not implemented yet" executeBottomQuery (Func operator left right) = do left <- executeBottomQuery left @@ -65,11 +66,11 @@ cardToHtml :: Card -> String cardToHtml (Card _ _ _ _ _ _ _ _ [cardFace]) = singleCardFaceHTML cardFace --Multiface card! -cardToHtml (Card _ _ _ _ _ _ _ _ cardFaces) = "
" ++ concatMap singleCardFaceHTML cardFaces ++"
" +cardToHtml (Card _ _ _ _ _ _ _ _ cardFaces) = "
" ++ concatMap singleCardFaceHTML cardFaces ++"
" singleCardFaceHTML :: CardFace -> String singleCardFaceHTML (CardFace _ _ name _ oracle_text type_line mana_cost (ImageUris _ _ _ image _ _ _ _)) = - "
" ++ + "
" ++ "

" ++ unpack name ++ "

" ++ ""++ "

" ++ unpack (Data.Maybe.fromMaybe "" type_line) ++ "

"++