Probably finished this time

src/Algorithm/BaseQuery.hs

@@ -8,16 +8,14 @@ module Algorithm.BaseQuery
     Tree(..),
     CardFace(..),
     ImageUris(..),
-    isLegal
+    isLegal,
+    notSuperType
     ) where
 import qualified Data.Text as T
 import Database.SQLite.Simple
 import Config (getDbPath)
 import Data.Text (Text, isInfixOf)
-import Control.Monad.IO.Class (MonadIO(liftIO))
 import Algorithm.Lex (Operator)
-import GHC.Generics (Generic)
-import Web.Scotty (rescue)
 
 
 {- 
@@ -98,10 +96,10 @@ instance Eq Card where
 
 --Re design fetching of cards by id to only gather the dbPath from config once!
 fetchCardsWithIds :: [ID] -> IO [Card]
-fetchCardsWithIds ids = do 
+fetchCardsWithIds ids = do
   dbPath <- getDbPath
   conn <- open dbPath
-  mapM (fetchCardWithId conn) ids 
+  mapM (fetchCardWithId conn) ids
 
 fetchCardWithId :: Connection -> ID -> IO Card
 fetchCardWithId conn (ID id)  = do
@@ -121,7 +119,6 @@ fetchImageUris conn (TempCardFace id card_id name cmc oracle_text type_line mana
 
 runQuerySimple :: (FromRow a) => Connection ->  Query -> IO [a]
 runQuerySimple conn str = do
-
   query_ conn str ::(FromRow a) =>  IO [a];
 
 runQueryNamed ::(FromRow a) => Connection -> Query -> [NamedParam] -> IO [a]
@@ -142,13 +139,22 @@ superType qry = do
   dbPath <- getDbPath
   conn <- open dbPath
   res <- runQuerySimple conn "select card.id, card_face.type_line from card inner join card_face where card.id = card_face.card_id and card_face.oracle_text is not null" :: IO [CardTypeLine]
-  cards <- fetchCardsWithIds (typeLineFilter res (T.pack qry))
+  cards <- fetchCardsWithIds (typeLineFilter res (T.pack qry) True)
   return $ Holder cards
 
-typeLineFilter :: [CardTypeLine] -> Text -> [ID]
+typeLineFilter :: [CardTypeLine] -> Text -> Bool -> [ID]
-typeLineFilter ((CardTypeLine id_ type_line):cards) qry = if qry `isInfixOf` type_line then ID id_:typeLineFilter cards qry else typeLineFilter cards qry
+typeLineFilter ((CardTypeLine id_ type_line):cards) qry True = if qry `isInfixOf` type_line then ID id_:typeLineFilter cards qry True else typeLineFilter cards qry True
-typeLineFilter [] _ = []
+typeLineFilter ((CardTypeLine id_ type_line):cards) qry False = if not (qry `isInfixOf` type_line) then ID id_:typeLineFilter cards qry False else typeLineFilter cards qry False
+typeLineFilter [] _ _ = []
 --------------------------------------------------------------
+notSuperType :: String -> IO Tree
+notSuperType qry = do
+  dbPath <- getDbPath
+  conn <- open dbPath
+  res <- runQuerySimple conn "select card.id, card_face.type_line from card inner join card_face where card.id = card_face.card_id and card_face.oracle_text is not null" :: IO [CardTypeLine]
+  cards <- fetchCardsWithIds (typeLineFilter res (T.pack qry) False)
+  return $ Holder cards
+
 
 newtype ID = ID Int
 instance FromRow ID where
@@ -182,8 +188,8 @@ isLegal :: String -> IO Tree
 isLegal qry = do
   dbPath <- getDbPath
   conn <- open dbPath
-  res <- runQueryNamed conn "select card.id from card inner join legalities where card.id = legalities.card_id and legalities.:val = legal" [":val" := qry] :: IO [ID]
+  res <- runQueryNamed conn "select card.id from card inner join legalities where card.id = legalities.card_id and format = :val and is_legal=1" [":val" := qry] :: IO [ID]
   cards <- fetchCardsWithIds res
   return $ Holder cards
-  
+
 

src/Algorithm/Lex.hs

@@ -82,6 +82,7 @@ data Token =
     deriving Show
 data QueryDef = 
     SuperType String|
+    NotSuperType String |
     Color String | 
     CMCLT Int | 
     CMCMT Int | 
@@ -117,6 +118,7 @@ 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 ("CmcLT", value) = case readMaybe value :: Maybe Int of 
     Just a -> Right $ CMCLT a
     Nothing -> Left $ ParseError "Could not parse number from call to CmcLT"

src/Algorithm/Search.hs

@@ -48,6 +48,7 @@ buildHtml = concatMap cardToHtml
 
 executeBottomQuery :: Token -> IO Tree
 executeBottomQuery (Queri (SuperType value)) = superType value
+executeBottomQuery (Queri (NotSuperType value)) = notSuperType value
 executeBottomQuery (Queri (CMCLT value)) = cmcLT value
 executeBottomQuery (Queri (CMCMT value)) = cmcMT value
 executeBottomQuery (Queri (CMCEQ value)) = cmcEQ value

src/Seed.hs

@@ -71,6 +71,8 @@ data Legalities =  Legalities{
 }deriving (Show,Generic)
 instance FromJSON Legalities
 
+data DbLegality = DbLegality Int Text Bool
+
 data Card = Card{
     c_id :: Text,
     lang :: Text,
@@ -115,7 +117,9 @@ instance FromJSON Card where
 
 data DbCard = DbCard Int Text Text Text Text (Maybe Float) (Maybe Text) (Maybe Text) (Maybe Text)
 
-instance ToRow Legalities
+instance ToRow DbLegality where
+    toRow(DbLegality id format legalStatus) =
+        toRow(id, format, legalStatus)
 
 instance ToRow DbCard where
     toRow (DbCard id scryfall_id lang name layout cmc oracle_text type_line mana_cost) =
@@ -161,7 +165,7 @@ seedData d = do
     execute_ conn "CREATE TABLE IF NOT EXISTS card (id INTEGER PRIMARY KEY, scryfall_id TEXT, lang TEXT, name TEXT, cmc INT, oracle_text TEXT, type_line TEXT, mana_cost TEXT)"
     execute_ conn "CREATE TABLE IF NOT EXISTS card_face (id INTEGER PRIMARY KEY,card_id INT, name TEXT, cmc INT, oracle_text TEXT, type_line TEXT, mana_cost TEXT)"
     execute_ conn "CREATE TABLE IF NOT EXISTS image_uris (id INTEGER PRIMARY KEY, card_face_id INT, small TEXT, normal TEXT, large TEXT, png TEXT, art_crop TEXT, border_crop TEXT)"
-    execute_ conn "CREATE TABLE IF NOT EXISTS legalities (id INTEGER PRIMARY KEY, card_id INT, standard TEXT, future TEXT, historic TEXT, gladiator TEXT, pioneer TEXT, explorer TEXT, modern TEXT, legacy TEXT, pauper TEXT, vintage TEXT, penny TEXT, commander TEXT, brawl TEXT, historicbrawl TEXT, alchemy TEXT, paupercommander TEXT, duel TEXT, oldschool TEXT, premodern TEXT, predh TEXT)"
+    execute_ conn "CREATE TABLE IF NOT EXISTS legalities (id INTEGER PRIMARY KEY,card_id INT, format TEXT, is_legal BOOL)"
 
 
     case d of
@@ -184,7 +188,7 @@ getJSONWeb = fetchData
 
 ---------------------------------------------------------------------------------------------------------
 
-collectCards :: Connection -> Int -> Int -> [Card] -> IO ([DbCard], [Legalities], [(CardFace, ImageUris)])
+collectCards :: Connection -> Int -> Int -> [Card] -> IO ([DbCard], [DbLegality], [(CardFace, ImageUris)])
 
 --Skip illegal card types that are not relevant (These are difficult to parse as they contain non standard card formats)
 collectCards conn card_id card_face_id ((Card _ _ _ layout _ _ _ _ _ _ _):cards) | unpack layout `Prelude.elem` ["scheme", "token", "double_faced_token", "emblem", "art_series", "vanguard", "host"] =
@@ -202,7 +206,7 @@ collectCards conn card_id card_face_id (card@(Card _ _ c_name _ c_cmc c_oracle_t
     let dbCard = cardToDbCard card_id card
     --insertRows conn dbCard legalities [(cardFace, imageUris)]
     (dbCards, legalitiesRest, cfius) <- collectCards conn (card_id + 1) (card_face_id + 1) cards
-    return (dbCard:dbCards, legalities:legalitiesRest, (cardFace, imageUris):cfius)
+    return (dbCard:dbCards, legalities++legalitiesRest, (cardFace, imageUris):cfius)
 
 --This will be ran when a card is multi face
 collectCards conn card_id card_face_id (card@(Card _ _ _ _ _ _ _ _ (Just card_faces) Nothing legal):cards) = do
@@ -211,7 +215,7 @@ collectCards conn card_id card_face_id (card@(Card _ _ _ _ _ _ _ _ (Just card_fa
     let cardFacesAndImageUris = addCardIdToCardFaces card_id card_face_id card_faces
     --insertRows conn dbCard legalities cardFacesAndImageUris
     (dbCards, legalitiesRest, cfius) <- collectCards conn (card_id + 1) (card_face_id + Prelude.length cardFacesAndImageUris+1) cards
-    return (dbCard:dbCards, legalities:legalitiesRest, cardFacesAndImageUris ++ cfius)
+    return (dbCard:dbCards, legalities++legalitiesRest, cardFacesAndImageUris ++ cfius)
 
 --This will be ran when a card contains multiple cards on the front
 collectCards conn card_id card_face_id (card@(Card _ _ _ _ _ _ _ _ (Just card_faces) (Just image_uris) legal):cards) = do
@@ -220,16 +224,17 @@ collectCards conn card_id card_face_id (card@(Card _ _ _ _ _ _ _ _ (Just card_fa
     let cardFacesAndImageUris =   addCardIdAndImageUrisToCardFaces card_id card_face_id image_uris card_faces
     --insertRows conn dbCard legalities cardFacesAndImageUris
     (dbCards, legalitiesRest, cfius) <- collectCards conn (card_id + 1) (card_face_id + Prelude.length cardFacesAndImageUris+1) cards
-    return (dbCard:dbCards, legalities:legalitiesRest, cardFacesAndImageUris ++ cfius)
+    return (dbCard:dbCards, legalities++legalitiesRest, cardFacesAndImageUris ++ cfius)
 
 collectCards _ _ _  [] = return ([],[],[])
 
 
 -- Helper functions for collectCards
 
-
+--God help me i know this is garbage
-insertIdLegalities :: Legalities -> Int -> Legalities
+insertIdLegalities :: Legalities -> Int -> [DbLegality]
-insertIdLegalities (Legalities Nothing a b c d e f g h i j k l m n o p q r s t) id = Legalities (Just id) a b c d e f g h i j k l m n o p q r s t
+insertIdLegalities (Legalities Nothing a b c d e f g h i j k l m n o p q r s t) id =
+    [DbLegality id "standard" (a=="legal"), DbLegality id "future" (b=="legal"), DbLegality id "historic" (c=="legal"), DbLegality id "gladiator" (d=="legal"), DbLegality id "pioneer" (e=="legal"), DbLegality id "explorer" (f=="legal"), DbLegality id "modern" (g=="legal"), DbLegality id "legacy" (h=="legal"), DbLegality id "pauper" (i=="legal"), DbLegality id "vintage" (j=="legal"), DbLegality id "penny" (k=="legal"), DbLegality id "commander" (l=="legal"), DbLegality id "brawl" (m=="legal"), DbLegality id "historicBrawl" (n=="legal"), DbLegality id "alchemy" (o=="legal"), DbLegality id "paupercommander" (p=="legal"), DbLegality id "duel" (q=="legal"), DbLegality id "oldschool" (r=="legal"), DbLegality id "premodern" (s=="legal"), DbLegality id "predh" (t=="legal")]
 insertIdLegalities _ _ = error $ "Illegal id insert into data legality"
 
 
@@ -257,10 +262,10 @@ addCardIdToCardFaces _ _ [] = []
 
 ---------------------------------------------------------------------------------------------------------------------------------------------------------------------
 
-fillDb :: Connection -> ([DbCard], [Legalities], [(CardFace, ImageUris)]) -> IO ()
+fillDb :: Connection -> ([DbCard], [DbLegality], [(CardFace, ImageUris)]) -> IO ()
 fillDb conn (dbCards, legalities, combo) = do
     let (cardFaces, imageUris) = unzip combo
     executeMany conn "INSERT INTO card (id, scryfall_id, lang, name, cmc, oracle_text, type_line, mana_cost ) VALUES (?,?,?,?,?,?,?,?)" dbCards
     executeMany conn "INSERT INTO card_face (id, card_id, name, cmc, oracle_text, type_line, mana_cost) VALUES (?,?,?,?,?,?,?)" cardFaces
     executeMany conn "INSERT INTO image_uris (card_face_id, small , normal , large , png , art_crop, border_crop) VALUES (?,?,?,?,?,?,?)" imageUris
-    executeMany conn "INSERT INTO legalities (card_id, standard  , future  , historic  , gladiator  , pioneer  , explorer  , modern  , legacy  , pauper  , vintage  , penny  , commander  , brawl  , historicbrawl  , alchemy  , paupercommander  , duel  , oldschool  , premodern, predh ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)" legalities
+    executeMany conn "INSERT INTO legalities (card_id, format, is_legal) VALUES (?,?,?)" legalities