Probably finished this time
This commit is contained in:
parent
6b4bda39fb
commit
c08ef8b714
4 changed files with 38 additions and 24 deletions
|
|
@ -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 id_ type_line):cards) qry = if qry `isInfixOf` type_line then ID id_:typeLineFilter cards qry else typeLineFilter cards qry
|
||||
typeLineFilter [] _ = []
|
||||
typeLineFilter :: [CardTypeLine] -> Text -> Bool -> [ID]
|
||||
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 ((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
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
27
src/Seed.hs
27
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
|
||||
|
||||
|
||||
insertIdLegalities :: Legalities -> Int -> Legalities
|
||||
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
|
||||
--God help me i know this is garbage
|
||||
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 =
|
||||
[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
|
||||
|
|
|
|||
Loading…
Reference in a new issue