Re-designed the entire database, need to verify all existing features. However i do belive this is a more scalable solution

src/Algorithm/BaseQuery.hs

@@ -13,64 +13,157 @@ import Config (getDbPath)
 import Data.Text (Text, isInfixOf)
 import Control.Monad.IO.Class (MonadIO(liftIO))
 import Algorithm.Lex (Operator)
+import GHC.Generics (Generic)
 
 
+{- 
+In this module we handle the "bottom" requests, these are made using Joins with only the minimum amount of data needed 
+
+Then the ID of the valid cards is used to fetch a full "Card" with all fields needed to show to the user
+-}
+
 data Tree = Funct Operator Tree Tree | Holder [Card]
 
+
+
+
+data ImageUris = ImageUris
+  Int
+  Int
+  T.Text
+  T.Text
+  T.Text
+  T.Text
+  T.Text
+  T.Text
+
+instance FromRow ImageUris where
+  fromRow = ImageUris <$> field <*> field <*> field <*> field <*> field <*> field <*> field <*> field
+
+
+data TempCardFace = TempCardFace
+  Int
+  Int
+  T.Text
+  (Maybe Int)
+  (Maybe T.Text)
+  (Maybe T.Text)
+  (Maybe T.Text)
+
+instance FromRow TempCardFace where
+  fromRow = TempCardFace <$> field <*> field <*> field <*> field <*> field <*> field <*> field
+
+
+data TempCard = TempCard
+  Int
+  T.Text
+  T.Text
+  T.Text
+  (Maybe Int)
+  (Maybe T.Text)
+  T.Text
+  (Maybe T.Text)
+instance FromRow TempCard where
+  fromRow = TempCard <$> field <*> field <*> field <*> field <*> field <*> field <*> field <*> field
+
+data CardFace = CardFace
+  Int
+  Int
+  T.Text
+  (Maybe Int)
+  (Maybe T.Text)
+  (Maybe T.Text)
+  (Maybe T.Text)
+  ImageUris
+
+
 data Card = Card
   Int
   T.Text
   T.Text
   T.Text
-  (Maybe T.Text)
+  (Maybe Int)
   (Maybe T.Text)
   T.Text
-  Int
+  (Maybe T.Text)
-  deriving (Show)
+  [CardFace]
+
 
 instance Eq Card where
-  (==) (Card id_ _ _ _ _ _ _ _) (Card id2_ _ _ _ _ _ _ _) = id_ == id2_
+  (==) (Card id_ _ _ _ _ _ _ _ _ ) (Card id2_ _ _ _ _ _ _ _ _ ) = id_ == id2_
-
-instance FromRow Card where
-  fromRow = Card <$> field <*> field <*> field <*> field <*> field <*> field <*> field <*> field
-
-instance ToRow Card where
-  toRow (Card id_ scryfall_id lang name oracle_text image_uri type_line cmc) = toRow (id_, scryfall_id, lang, name, oracle_text, image_uri, type_line, cmc)
 
 
-runQuerySimple :: Query -> IO [Card]
+fetchCardsWithIds :: [ID] -> IO [Card]
+fetchCardsWithIds = mapM fetchCardWithId
+
+fetchCardWithId :: ID -> IO Card
+fetchCardWithId (ID id) = do
+  tempCardFaces <- runQueryNamed "select id, card_id, name, cmc, oracle_text, type_line, mana_cost from card_face where card_id = :val" [":val" := id] :: IO [TempCardFace]
+  --We are fetchinig based on primary key, so we know the result is a single data
+  [TempCard id scryfall_id lang name cmc oracle_text type_line mana_cost] <- runQueryNamed "select id, scryfall_id, lang, name, cmc, oracle_text,type_line, mana_cost from card where id = :val" [":val" := id] :: IO [TempCard]
+  cardFaces <- mapM fetchImageUris tempCardFaces
+  return $ Card id scryfall_id lang name cmc oracle_text type_line mana_cost cardFaces
+
+fetchImageUris :: TempCardFace -> IO (CardFace)
+fetchImageUris (TempCardFace id card_id name cmc oracle_text type_line mana_cost) = do
+  --We can do this only because a ImageUri row is 1:1 with CardFace in the database
+  [imageUri] <- runQueryNamed "select id, card_face_id, small, normal, large, png, art_crop, border_crop from image_uris where card_face_id = :val" [":val" := id] :: IO [ImageUris]
+  return $ CardFace id card_id name cmc oracle_text type_line mana_cost imageUri
+
+
+
+runQuerySimple :: (FromRow a) =>  Query -> IO [a]
 runQuerySimple str = do
   dbPath <- getDbPath
   conn <- open dbPath
-  query_ conn str :: IO [Card];
+  query_ conn str ::(FromRow a) =>  IO [a];
 
-runQueryNamed :: Query -> [NamedParam] -> IO [Card]
+runQueryNamed ::(FromRow a) =>  Query -> [NamedParam] -> IO [a]
 runQueryNamed qur parm = do
   dbPath <- getDbPath
   conn <- open dbPath
-  queryNamed conn qur parm :: IO [Card]
+  queryNamed conn qur parm :: (FromRow a) =>  IO [a]
 
 
+--------------------------------------------------------------
+data CardTypeLine = CardTypeLine
+  Int
+  T.Text
+
+instance FromRow CardTypeLine where
+  fromRow = CardTypeLine <$> field <*> field
+
 superType :: String -> IO Tree
 superType qry = do
-  res <- runQuerySimple "select id, scryfall_id, lang, name, oracle_text, image_uri, type_line, cmc from card where type_line is not null"
+  res <- runQuerySimple "select card.id, card_face.oracle_text from card inner join card_face where card.id = card_face.card_id and card_face.oracle_text is not null" :: IO [CardTypeLine]
-  return $ Holder (typeLineFilter res (T.pack qry))
+  cards <- fetchCardsWithIds (typeLineFilter res (T.pack qry))
+  return $ Holder cards
 
-typeLineFilter :: [Card] -> Text -> [Card]
+typeLineFilter :: [CardTypeLine] -> Text -> [ID]
-typeLineFilter (card@(Card _ _ _ _ _ _ type_line _):cards) qry = if qry `isInfixOf` type_line then card:typeLineFilter cards qry else typeLineFilter cards qry
+typeLineFilter (card@(CardTypeLine id type_line):cards) qry = if qry `isInfixOf` type_line then ID id:typeLineFilter cards qry else typeLineFilter cards qry
 typeLineFilter [] _ = []
+--------------------------------------------------------------
+
+newtype ID = ID Int
+instance FromRow ID where
+  fromRow = ID <$> field
 
 cmcLT :: Int -> IO Tree
 cmcLT value = do
-  res <- runQueryNamed "select id, scryfall_id, lang, name, oracle_text, image_uri, type_line, cmc from card where cmc < :val" [":val" := value]
+  res <- runQueryNamed "select card.id from card inner join card_face where card.id = card_face.card_id and (card.cmc < :val or card_face.cmc < :val)" [":val" := value] :: IO [ID]
-  return $ Holder res
+  cards <- fetchCardsWithIds res
+  return $ Holder cards
 
 cmcMT :: Int -> IO Tree
 cmcMT value = do
-  res <- runQueryNamed "select id, scryfall_id, lang, name, oracle_text, image_uri, type_line, cmc from card where cmc > :val" [":val" := value]
+  res <- runQueryNamed "select card.id from card inner join card_face where card.id = card_face.card_id and (card.cmc > :val or card_face.cmc > :val)" [":val" := value] :: IO [ID]
-  return $ Holder res
+  cards <- fetchCardsWithIds res
+  return $ Holder cards
 
 cmcEQ :: Int -> IO Tree
 cmcEQ value = do
-  res <- runQueryNamed "select id, scryfall_id, lang, name, oracle_text, image_uri, type_line, cmc from card where cmc = :val" [":val" := value]
+  res <- runQueryNamed "select card.id from card inner join card_face where card.id = card_face.card_id and (card.cmc = :val or card_face.cmc = :val)" [":val" := value] :: IO [ID]
-  return $ Holder res
+  cards <- fetchCardsWithIds res
+  return $ Holder cards
+
+

src/Algorithm/Lex.hs

@@ -3,18 +3,19 @@ module Algorithm.Lex
     ( lexx
     , Token(..)
     , QueryDef(..)
-    , Operator(..)) where
+    , Operator(..)
+    , ParseError(..)) where
 import Prelude hiding (lex)
-import Debug.Trace
+import Data.Either
-import Data.ByteString (count, putStr)
+import Text.Read (readMaybe)
 
-
+lexx :: String -> Either ParseError Token
-lexx :: String -> Token
 lexx qur = do
     let collected = clearRepeatedSpaces $ collector $ strip $ stripFront $ clearIllegalCharacters qur
     let parenthesises = matchParenthesis collected 0
     let (parenthesisFixed, parenthesis) = fixSeparators collected parenthesises
     seperator parenthesisFixed parenthesis
+        
 
 stripFront :: [Char] -> [Char]
 stripFront = dropWhile (==' ')
@@ -29,7 +30,7 @@ strip [] = []
 
 
 fixSeparators :: [String] -> [(Int, Int)] -> ([String], [(Int, Int)])
-fixSeparators values parenthesis@((start,end):rest) | start == 0 && end == ( length values -1) = (values, parenthesis)
+fixSeparators values parenthesis@((start,end):_) | start == 0 && end == ( length values -1) = (values, parenthesis)
 fixSeparators values parenthesis  = ( ["("] ++ values ++ [")"], (0, length values + 1):map addOne parenthesis)
 
 
@@ -73,7 +74,12 @@ findClosing (x:xs) stackCount count = findClosing xs stackCount (count+1)
 findClosing [] _ _ = error "Unequal number of parenthesis"
 
 
-data Token = Func Operator Token Token | Queri QueryDef deriving Show
+newtype ParseError = ParseError String
+
+data Token = 
+    Func Operator Token Token | 
+    Queri QueryDef 
+    deriving Show
 data QueryDef = 
     SuperType String|
     Color String | 
@@ -87,24 +93,41 @@ data Operator =
     Minus
     deriving Show
 
-seperator :: [String] -> [(Int, Int)] -> Token
+seperator :: [String] -> [(Int, Int)] -> Either ParseError Token
-seperator ("(":rest) ((start,end):points) = case drop (end-start) rest of
-            " ":operator:" ":"(":rightRest -> Func (extractOperator operator) (seperator (take (end-start) rest) points)   (seperator (init rightRest) points)
-            [] -> seperator (take (end-start) rest) points
-            _ ->error "Operator need something to the right and left of it!"
-seperator [name, " ", value, ")"] _ = Queri (extractQueryDef (name, value))
-seperator a _ = error $ "Something went wrong tokenizing the input!\n" ++ (show a) 
 
-extractQueryDef :: (String, String) -> QueryDef
+seperator ("(":rest) ((start,end):points) = case drop (end-start) rest of
-extractQueryDef ("SuperType", value) = SuperType value
+            " ":operator:" ":"(":rightRest -> case spawnBranch (extractOperator operator) (seperator (take (end-start) rest) points)  (seperator (init rightRest) points) of
-extractQueryDef ("CmcLT", value) = CMCLT (read value :: Int)
+                Left a -> Left a
-extractQueryDef ("CmcMT", value) = CMCMT (read value :: Int)
+                Right b -> Right b
-extractQueryDef ("CmcEQ", value) = CMCEQ (read value :: Int)
+            [] -> seperator (take (end-start) rest) points
-extractQueryDef _ = error $ "This command was not valid"
+            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
+seperator a _ = Left (ParseError ("Something went wrong tokenizing the input!\n" ++ (show a)))
+
+spawnBranch :: Operator -> (Either ParseError Token) -> (Either ParseError Token) -> (Either ParseError Token)
+spawnBranch _ (Left res1) _ = Left res1
+spawnBranch _ _ (Left res2) = Left res2
+spawnBranch operator (Right res1) (Right res2) = Right (Func operator res1 res2)
+
+
+
+
+extractQueryDef :: (String, String) -> Either ParseError QueryDef
+extractQueryDef ("SuperType", value) = Right $ SuperType 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"
+extractQueryDef ("CmcMT", value) = case readMaybe value :: Maybe Int of 
+    Just a -> Right $ 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
+    Nothing -> Left $ ParseError "Could not parse number from call to CmcEQ"
+extractQueryDef (a,b) = Left $ ParseError $ "The following command is invalid " ++ show a
 
 extractOperator "union" = Union
 extractOperator "intersect" = Intersect
 extractOperator "minus" = Minus
 extractOperator _ = error $ "This operator is not defined"
--- ((Is instant) union (Color R)) union ((Is instant) union (Color R))
--- (((Color Red) union (Color Blue)) union ((Is instant) union (Is Enchantment)))

src/Algorithm/Search.hs

@@ -17,14 +17,16 @@ import Data.Aeson.Encoding (value)
 
 search :: String -> IO String
 search q = do
-  let tokens = lexx q
+  case lexx q of
+      Left (ParseError message) -> return message
+      Right tokens ->do 
+        tree <- executeBottomQuery tokens
+        let queryRes = executeQuery tree
+        let hyperText = buildHtml queryRes
+        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
-  tree <- executeBottomQuery tokens
 
-  let queryRes = executeQuery tree
-  let hyperText = buildHtml queryRes
-  return hyperText
 
 
 
@@ -57,10 +59,7 @@ executeBottomQuery (Func operator left right) = do
 
 
 cardToHtml :: Card -> String
-cardToHtml (Card id_ scryfall_id lang name (Just oracle_text) (Just image_uri) type_line cmc) =
+cardToHtml (Card _ _ _ name (Just cmc) (Just oracle_text) type_line (Just mana_cost) _) =
   "<div class=\"card\" style=\"text-align:center\"><h2>" ++ unpack name ++ "</h2>" ++
-  "<img src=" ++ unpack image_uri ++ " width=\"200px\"/>"++
   "<p style=\"width:205px;margin: 0 auto;font-size:12;\">" ++ unpack oracle_text ++ "<p>"++" </div>"
-
-
 cardToHtml _ = "<h1>Could not load that card</h1>"

src/Seed.hs

@@ -1,10 +1,10 @@
 {-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
 module Seed
-    ( seedDataFile, seedDataWeb
+    ( seedDataFile, seedDataWeb, DbCard(..)
     ) where
 
-import Data.Aeson ( eitherDecode, FromJSON, ToJSON )
+import Data.Aeson ( eitherDecode, FromJSON (parseJSON), ToJSON (toJSON), Value (Object), (.:), fromJSON, Key, (.:?) )
-import Data.Text
+import Data.Text as T
 
 import qualified Data.ByteString.Lazy as B
 
@@ -14,7 +14,28 @@ 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,
@@ -25,24 +46,89 @@ data ImageUris = ImageUris {
 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{
-    object :: Text,
+    c_id :: Text,
-    id :: Text,
     lang :: Text,
-    name :: Text,
+    c_name:: Text,
-    oracle_text :: Maybe Text,
+    layout:: Text,
-    image_uris :: Maybe ImageUris,
+    c_cmc:: Maybe Float,
-    type_line :: Maybe Text,
+    c_oracle_text:: Maybe Text,
-    cmc :: Int
+    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
+instance FromJSON Card where
-instance ToJSON Card
+    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)
 
-instance ToRow Card where
+data DbCard = DbCard Int Text Text Text Text (Maybe Float) (Maybe Text) (Maybe Text) (Maybe Text)
-    toRow (Card object id lang name oracle_text (Just (ImageUris _ image_link _ _ _ _ )) type_line cmc) = 
+
-        toRow (id, lang, name, oracle_text, image_link, type_line, cmc)
+instance ToRow Legalities
-    toRow (Card object id lang name oracle_text Nothing type_line cmc) = toRow (id, lang, name, oracle_text, Nothing:: (Maybe Text), type_line, cmc)
+
+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
@@ -57,17 +143,33 @@ 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 "CREATE TABLE IF NOT EXISTS card (id INTEGER PRIMARY KEY, scryfall_id TEXT, lang TEXT, name TEXT, oracle_text TEXT, image_uri TEXT, type_line TEXT, cmc INT)"
+    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 ps
+        Right ps -> insertCards conn 0 0 ps
+
+
+
 
 getJSON :: String -> IO B.ByteString
 getJSON = B.readFile
@@ -75,10 +177,93 @@ getJSON = B.readFile
 getJSONWeb :: IO B.ByteString
 getJSONWeb = fetchData
 
-insertCards :: Connection -> [Card] -> IO()
+---------------------------------------------------------------------------------------------------------
-insertCards conn ((card):cards) = do
-    execute conn "INSERT INTO card (scryfall_id, lang, name, oracle_text, image_uri, type_line, cmc) VALUES (?,?,?,?,?,?,?)" card
-    insertCards conn cards
-    return ()
-insertCards conn [] = return ()
 
+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

src/Site/Static/index.html

@@ -2,16 +2,19 @@
 <html>
 <body>
 
-<h1>This is a heading</h1>
+    <div>
+        <h1>This is a heading</h1>
 
-<p>This site will be to search for magic the gathering cards using a custom sort of DSL!</p>
+        <p>This site will be to search for magic the gathering cards using a custom sort of DSL!</p>
+    
+    
+        <form method="POST" action="/api/req"> 
+            <textarea rows="5" cols="33" name="query"></textarea>
+            <button type="submit">SHIP IT!</button>
+        </form>
+    </div>
 
 
-<form method="POST" action="/api/req"> 
-    <textarea rows="5" cols="33" name="query"></textarea>
-    <button type="submit">SHIP IT!</button>
-</form>
-
 </body>
 </html>