{-# LANGUAGE DeriveGeneric, OverloadedStrings #-} module Seed ( seedDataFile, seedDataWeb, DbCard(..) ) where import Data.Aeson ( eitherDecode, FromJSON (parseJSON), ToJSON (toJSON), Value (Object), (.:), fromJSON, Key, (.:?) ) import Data.Text as T import qualified Data.ByteString.Lazy as B import Database.SQLite.Simple import Config import GHC.Generics import DataFetcher (fetchData) import Prelude hiding (id) import Control.Exception (IOException, try, SomeException) import Data.Aeson.KeyMap (keys, insert) import Data.Aeson.Types (toJSONKeyKey, Parser) data CardFace = CardFace { id :: Maybe Int, card_id :: Maybe Int, name:: Text, cmc::Maybe Float, oracle_text::Maybe Text, image_uris:: Maybe ImageUris, type_line :: Maybe Text, mana_cost:: Maybe Text }deriving (Show,Generic) instance FromJSON CardFace instance ToJSON CardFace data ImageUris = ImageUris { card_face_id :: Maybe Int, small :: Text, normal :: Text, large :: Text, png :: Text, art_crop :: Text, border_crop :: Text }deriving (Show,Generic) instance FromJSON ImageUris instance ToJSON ImageUris data Legalities = Legalities{ cardId :: Maybe 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 }deriving (Show,Generic) instance FromJSON Legalities data Card = Card{ c_id :: Text, lang :: Text, c_name:: Text, layout:: Text, c_cmc:: Maybe Float, c_oracle_text:: Maybe Text, c_type_line :: Maybe Text, c_mana_cost:: Maybe Text, card_faces:: Maybe [CardFace], c_image_uris :: Maybe ImageUris, legalities :: Legalities } deriving (Show,Generic) instance FromJSON Card where parseJSON (Object v) = do c_name <- v.: "name" c_id <- v .: "id" lang <- v .: "lang" c_cmc <- v .:? "cmc" c_oracle_text <- v .:? "oracle_text" c_type_line <- v .:? "type_line" c_mana_cost <- v .:? "mana_cost" card_faces <- v .:? "card_faces" layout <- v .: "layout" c_image_uris <- v .:? "image_uris" legalities <- v .: "legalities" return (Card { c_id = c_id, lang = lang, c_name = c_name, c_cmc = c_cmc, c_oracle_text = c_oracle_text, c_type_line = c_type_line, c_mana_cost = c_mana_cost, card_faces = card_faces, layout = layout, c_image_uris = c_image_uris, legalities = legalities }) parseJSON a = error $ "could not parse card " ++ (show a) data DbCard = DbCard Int Text Text Text Text (Maybe Float) (Maybe Text) (Maybe Text) (Maybe Text) instance ToRow Legalities instance ToRow DbCard where toRow (DbCard id scryfall_id lang name layout cmc oracle_text type_line mana_cost) = toRow (id, scryfall_id, lang, name, cmc, oracle_text, type_line, mana_cost) instance ToRow CardFace where toRow(CardFace c_id card_id name cmc oracle_text image_uris type_line mana_cost) = toRow (c_id, card_id, name, cmc, oracle_text, type_line, mana_cost) instance ToRow ImageUris where toRow (ImageUris card_face_id small normal large png art_crop border_crop) = toRow (card_face_id, small, normal, large, png, art_crop, border_crop) seedDataFile :: IO () seedDataFile = do -- Get JSON data and decode it d <- getDataSeedPath dat <- (eitherDecode <$> getJSON d) :: IO (Either String [Card]) seedData dat seedDataWeb :: IO () seedDataWeb = do dat <- (eitherDecode <$> getJSONWeb) :: IO (Either String [Card]) seedData dat cardToDbCard :: Int -> Card -> DbCard cardToDbCard id (Card scryfall_id lang c_name layout c_cmc c_oracle_text c_type_line c_mana_cost _ _ _) = DbCard id scryfall_id lang c_name layout c_cmc c_oracle_text c_type_line c_mana_cost seedData d = do dbPath <- getDbPath conn <- open dbPath execute_ conn "DROP TABLE IF EXISTS card" execute_ conn "DROP TABLE IF EXISTS image_uris" execute_ conn "DROP TABLE IF EXISTS card_face" execute_ conn "DROP TABLE IF EXISTS legalities" 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 BOOL, future BOOL, historic BOOL, gladiator BOOL, pioneer BOOL, explorer BOOL, modern BOOL, legacy BOOL, pauper BOOL, vintage BOOL, penny BOOL, commander BOOL, brawl BOOL, historicbrawl BOOL, alchemy BOOL, paupercommander BOOL, duel BOOL, oldschool BOOL, premodern BOOL, predh BOOL)" case d of Left err -> putStrLn err Right ps -> insertCards conn 0 0 ps getJSON :: String -> IO B.ByteString getJSON = B.readFile getJSONWeb :: IO B.ByteString getJSONWeb = fetchData --------------------------------------------------------------------------------------------------------- insertCards :: Connection -> Int -> Int -> [Card] -> IO() --Skip illegal card types that are not relevant (These are difficult to parse as they contain non standard card formats) insertCards conn card_id card_face_id ((Card _ _ _ layout _ _ _ _ _ _ _):cards) | unpack layout `Prelude.elem` ["scheme", "token", "double_faced_token", "emblem", "art_series", "vanguard", "host"] = insertCards conn card_id card_face_id cards --This should in theory never happen, however it is here for full coverage insertCards _ _ _ (card@(Card _ _ _ _ _ _ _ _ Nothing Nothing _):_) = do error $ "This cannot happen! No card can not have cardfaces as well as no image_uris on top level. Please fix ur data!" --This will be ran when the card is single face (most cards) insertCards conn card_id card_face_id (card@(Card _ _ c_name _ c_cmc c_oracle_text c_type_line c_mana_cost Nothing image_uris@(Just (ImageUris _ small normal large png art_crop border_crop)) legal):cards) = do let legalities = insertIdLegalities legal card_id let cardFace = CardFace (Just card_face_id) (Just card_id) c_name c_cmc c_oracle_text Nothing c_type_line c_mana_cost let imageUris = ImageUris (Just card_face_id) small normal large png art_crop border_crop let dbCard = cardToDbCard card_id card insertRows conn dbCard legalities [(cardFace, imageUris)] insertCards conn (card_id + 1) (card_face_id + 1) cards --This will be ran when a card is multi face insertCards conn card_id card_face_id (card@(Card _ _ _ _ _ _ _ _ (Just card_faces) Nothing legal):cards) = do let legalities = insertIdLegalities legal card_id let dbCard = cardToDbCard card_id card let cardFacesAndImageUris = addCardIdToCardFaces card_id card_face_id card_faces insertRows conn dbCard legalities cardFacesAndImageUris insertCards conn (card_id + 1) (card_face_id + Prelude.length cardFacesAndImageUris+1) cards --This will be ran when a card contains multiple cards on the front insertCards conn card_id card_face_id (card@(Card _ _ _ _ _ _ _ _ (Just card_faces) (Just image_uris) legal):cards) = do let legalities = insertIdLegalities legal card_id let dbCard = cardToDbCard card_id card let cardFacesAndImageUris = addCardIdAndImageUrisToCardFaces card_id card_face_id image_uris card_faces insertRows conn dbCard legalities cardFacesAndImageUris insertCards conn (card_id + 1) (card_face_id + Prelude.length cardFacesAndImageUris+1) cards insertCards _ _ _ [] = return () 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 insertIdLegalities _ _ = error $ "Illegal id insert into data legality" --------------------------------------------------------------------------------------------------------- addCardIdAndImageUrisToCardFaces :: Int -> Int -> ImageUris -> [CardFace] -> [(CardFace, ImageUris)] addCardIdAndImageUrisToCardFaces card_id card_face_id image_uri (card_face:faces) = addCardIdAndImageUrisToCardFace card_id card_face_id image_uri card_face : addCardIdAndImageUrisToCardFaces card_id (card_face_id+1) image_uri faces addCardIdAndImageUrisToCardFaces _ _ _ [] = [] addCardIdAndImageUrisToCardFace :: Int -> Int -> ImageUris -> CardFace -> (CardFace, ImageUris) addCardIdAndImageUrisToCardFace card_id card_face_id (ImageUris _ small normal large png art_crop border_crop) (CardFace Nothing Nothing c_name c_cmc c_oracle_text Nothing c_type_line c_mana_cost) = (CardFace (Just card_face_id) (Just card_id) c_name c_cmc c_oracle_text Nothing c_type_line c_mana_cost, ImageUris (Just card_face_id) small normal large png art_crop border_crop) addCardIdAndImageUrisToCardFace _ _ _ _ = error $ "This cardface and imageUris are not compatible" addCardIdToCardFace :: Int -> Int -> CardFace -> (CardFace,ImageUris) addCardIdToCardFace card_id card_face_id (CardFace Nothing Nothing c_name c_cmc c_oracle_text (Just (ImageUris i_card_face_id small normal large png art_crop border_crop)) c_type_line c_mana_cost) = (CardFace (Just card_face_id) (Just card_id) c_name c_cmc c_oracle_text Nothing c_type_line c_mana_cost, ImageUris (Just card_face_id) small normal large png art_crop border_crop) addCardIdToCardFace _ _ _ = error $ "This cardface already has an id associated with it!" addCardIdToCardFaces :: Int -> Int -> [CardFace] -> [(CardFace, ImageUris)] addCardIdToCardFaces card_id card_face_id (card:cards) = addCardIdToCardFace card_id card_face_id card : addCardIdToCardFaces card_id (card_face_id +1) cards addCardIdToCardFaces _ _ [] = [] insertRows :: Connection -> DbCard -> Legalities -> [(CardFace, ImageUris)] -> IO() insertRows conn dbCard legalities face_uri = do mapM_ (insertCardFaceImageUris conn) face_uri insertCard conn dbCard insertLegalities conn legalities insertCardFaceImageUris :: Connection -> (CardFace, ImageUris) -> IO () insertCardFaceImageUris conn (cardFace, imageUris) = do execute conn "INSERT INTO card_face (id, card_id, name, cmc, oracle_text, type_line, mana_cost) VALUES (?,?,?,?,?,?,?)" cardFace execute conn "INSERT INTO image_uris (card_face_id, small , normal , large , png , art_crop, border_crop) VALUES (?,?,?,?,?,?,?)" imageUris insertCard :: Connection -> DbCard -> IO () insertCard conn card = do execute conn "INSERT INTO card (id, scryfall_id, lang, name, cmc, oracle_text, type_line, mana_cost ) VALUES (?,?,?,?,?,?,?,?)" card insertLegalities :: Connection -> Legalities -> IO () insertLegalities conn legalities = do execute 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