diff --git a/src/Algorithm/Search.hs b/src/Algorithm/Search.hs index df51343..eecb637 100644 --- a/src/Algorithm/Search.hs +++ b/src/Algorithm/Search.hs @@ -9,13 +9,14 @@ import Control.Monad import qualified Data.Text as T -data TestField = TestField Int T.Text deriving (Show) +data Card = Card Int T.Text T.Text deriving (Show) -instance FromRow TestField where - fromRow = TestField <$> field <*> field +instance FromRow Card where + fromRow = Card <$> field <*> field <*> field -instance ToRow TestField where - toRow (TestField id_ str) = toRow (id_, str) +instance ToRow Card where + + toRow (Card id_ str image_uri) = toRow (id_, str, image_uri) search :: String -> IO String search q = do @@ -25,5 +26,12 @@ simpleSearch :: String -> IO String simpleSearch q = do dbPath <- getDbPath conn <- open dbPath - res <- queryNamed conn "select id, name from card where name like :name" [":name" := ("%"++q++"%")] :: IO [TestField] - return (show res) \ No newline at end of file + res <- queryNamed conn "select id, name, image_uri from card where name like :name" [":name" := ("%"++q++"%")] :: IO [Card] + let hyperText = buildHtml res + return hyperText + +buildHtml :: [Card] -> String +buildHtml = concatMap cardToHtml + +cardToHtml :: Card -> String +cardToHtml (Card id name image_uri) = "

" ++ show name ++ "

" ++ "" \ No newline at end of file diff --git a/src/Lib.hs b/src/Lib.hs index 22a5e5a..dbeeeb2 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -4,31 +4,40 @@ module Lib ) where import Data.Aeson import Data.Text -import Control.Applicative -import Control.Monad + import qualified Data.ByteString.Lazy as B -import Control.Applicative -import qualified Data.Text as T + import Database.SQLite.Simple import Config import GHC.Generics -import GHC.Read (readField) +data ImageUris = ImageUris { + small :: Text, + normal :: Text, + large :: Text, + png :: Text, + art_crop :: Text, + border_crop :: Text +}deriving (Show,Generic) +instance FromJSON ImageUris +instance ToJSON ImageUris data Card = Card{ object :: Text, id :: Text, lang :: Text, name :: Text, - oracle_text :: Maybe Text + oracle_text :: Maybe Text, + image_uris :: Maybe ImageUris } deriving (Show,Generic) instance FromJSON Card instance ToJSON Card instance ToRow Card where - toRow (Card object id lang name oracle_text) = toRow (id, lang, name, oracle_text) + toRow (Card object id lang name oracle_text (Just (ImageUris _ image_link _ _ _ _ ))) = toRow (id, lang, name, oracle_text, image_link) + toRow (Card object id lang name oracle_text Nothing) = toRow (id, lang, name, oracle_text, pack "Nothing") @@ -37,7 +46,7 @@ getJSON file = B.readFile file insertCards :: Connection -> [Card] -> IO() insertCards conn ((card):cards) = do - execute conn "INSERT INTO card (scryfall_id, lang, name, oracle_text) VALUES (?,?,?,?)" card + execute conn "INSERT INTO card (scryfall_id, lang, name, oracle_text, image_uri) VALUES (?,?,?,?,?)" card insertCards conn cards return () insertCards conn [] = return () @@ -48,9 +57,9 @@ seedData = do seedData <- getDataSeedPath dbPath <- getDbPath - d <- (eitherDecode <$> getJSON seedData) :: IO (Either String [Card]) + d <- (eitherDecode <$> getJSON seedData) :: IO (Either String [Card]) 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)" + 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)" case d of