Fixed lazy file loading by only loading the database path when needed, and only ounce

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"
 }

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
   

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"
 
 
 

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

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 ["<h1>", pack result, "</h1>"]
+            html $ mconcat [pack result]
 
   get "/" $ file "src/Site/Static/index.html"