From 6b4bda39fb2258f697cea86d0a4f1e8d6c9fed8f Mon Sep 17 00:00:00 2001 From: polsevev Date: Fri, 5 May 2023 20:43:37 +0200 Subject: [PATCH] Fixed lazy file loading by only loading the database path when needed, and only ounce --- Config/config.json | 2 +- src/Algorithm/BaseQuery.hs | 56 ++++++++++++++++++++++---------------- src/Config.hs | 6 ++-- src/Seed.hs | 19 ------------- src/Site/Host.hs | 2 +- 5 files changed, 38 insertions(+), 47 deletions(-) diff --git a/Config/config.json b/Config/config.json index 7a2218a..a041ee1 100644 --- a/Config/config.json +++ b/Config/config.json @@ -1,5 +1,5 @@ { - "dataseedpath" : "data/small.json", + "dataseedpath" : "./data/small.json", "dbPath" : "data/db.db", "bulkDataLink" : "https://data.scryfall.io/default-cards/default-cards-20230430090702.json" } diff --git a/src/Algorithm/BaseQuery.hs b/src/Algorithm/BaseQuery.hs index 261313f..c204ef3 100644 --- a/src/Algorithm/BaseQuery.hs +++ b/src/Algorithm/BaseQuery.hs @@ -96,36 +96,36 @@ data Card = Card instance Eq Card where (==) (Card id_ _ _ _ _ _ _ _ _ ) (Card id2_ _ _ _ _ _ _ _ _ ) = id_ == id2_ - +--Re design fetching of cards by id to only gather the dbPath from config once! fetchCardsWithIds :: [ID] -> IO [Card] -fetchCardsWithIds = mapM fetchCardWithId +fetchCardsWithIds ids = do + dbPath <- getDbPath + conn <- open dbPath + mapM (fetchCardWithId conn) ids -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] +fetchCardWithId :: Connection -> ID -> IO Card +fetchCardWithId conn (ID id) = do + tempCardFaces <- runQueryNamed conn "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 + [TempCard id scryfall_id lang name cmc oracle_text type_line mana_cost] <- runQueryNamed conn "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 conn) 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 +fetchImageUris ::Connection -> TempCardFace -> IO (CardFace) +fetchImageUris conn (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] + [imageUri] <- runQueryNamed conn "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 +runQuerySimple :: (FromRow a) => Connection -> Query -> IO [a] +runQuerySimple conn str = do + query_ conn str ::(FromRow a) => IO [a]; -runQueryNamed ::(FromRow a) => Query -> [NamedParam] -> IO [a] -runQueryNamed qur parm = do - dbPath <- getDbPath - conn <- open dbPath +runQueryNamed ::(FromRow a) => Connection -> Query -> [NamedParam] -> IO [a] +runQueryNamed conn qur parm = do queryNamed conn qur parm :: (FromRow a) => IO [a] @@ -139,7 +139,9 @@ instance FromRow CardTypeLine where superType :: String -> IO Tree superType qry = do - res <- runQuerySimple "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] + 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)) return $ Holder cards @@ -154,25 +156,33 @@ instance FromRow ID where cmcLT :: Int -> IO Tree cmcLT value = do - 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] + dbPath <- getDbPath + conn <- open dbPath + res <- runQueryNamed conn "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] cards <- fetchCardsWithIds res return $ Holder cards cmcMT :: Int -> IO Tree cmcMT value = do - 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] + dbPath <- getDbPath + conn <- open dbPath + res <- runQueryNamed conn "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] cards <- fetchCardsWithIds res return $ Holder cards cmcEQ :: Int -> IO Tree cmcEQ value = do - 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] + dbPath <- getDbPath + conn <- open dbPath + res <- runQueryNamed conn "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] cards <- fetchCardsWithIds res return $ Holder cards isLegal :: String -> IO Tree isLegal qry = do - res <- runQueryNamed "select card.id from card inner join legalities where card.id = legalities.card_id and legalities.:val = legal" [":val" := qry] :: IO [ID] + 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] cards <- fetchCardsWithIds res return $ Holder cards diff --git a/src/Config.hs b/src/Config.hs index 3875bd1..e8d0ffb 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -32,10 +32,10 @@ configFile = "./Config/config.json" getJSON :: IO B.ByteString getJSON = do - a <- try $ L.readFile configFile :: IO (Either IOException String) + a <- try $ B.readFile configFile :: IO (Either IOException B.ByteString ) case a of - Right a2 -> return $ C8.pack a2 - Left b -> error $ "Could not load configuration file " ++ (show b) + Right a -> return a + Left b -> error $ "Could not load configuration file" diff --git a/src/Seed.hs b/src/Seed.hs index 9094254..c13efac 100644 --- a/src/Seed.hs +++ b/src/Seed.hs @@ -264,22 +264,3 @@ fillDb conn (dbCards, legalities, combo) = do 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 --- 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 \ No newline at end of file diff --git a/src/Site/Host.hs b/src/Site/Host.hs index a0fad80..9f257ca 100644 --- a/src/Site/Host.hs +++ b/src/Site/Host.hs @@ -17,7 +17,7 @@ host = scotty 3000 $ do --liftIO (putStrLn $ "\nOutput! " ++ show (lexx query)) --cards <- liftIO (search query) result <- liftIO (search query) - html $ mconcat ["

", pack result, "

"] + html $ mconcat [pack result] get "/" $ file "src/Site/Static/index.html"