Initial simple search has been implemented
This commit is contained in:
parent
081820e5ca
commit
c0d0e91dc4
7 changed files with 79 additions and 7 deletions
|
@ -1,12 +1,13 @@
|
||||||
|
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
import System.Environment
|
import System.Environment
|
||||||
|
import Site.Host
|
||||||
import Lib
|
import Lib
|
||||||
|
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
case args of
|
case args of
|
||||||
["--seed"] -> seedData
|
["--seed"] -> seedData
|
||||||
_ -> putStrLn "Run the main app"
|
_ -> host
|
||||||
|
|
|
@ -25,8 +25,10 @@ source-repository head
|
||||||
|
|
||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
|
Algorithm.Search
|
||||||
Config
|
Config
|
||||||
Lib
|
Lib
|
||||||
|
Site.Host
|
||||||
other-modules:
|
other-modules:
|
||||||
Paths_mtgsearch
|
Paths_mtgsearch
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
|
@ -36,6 +38,8 @@ library
|
||||||
aeson
|
aeson
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, bytestring
|
, bytestring
|
||||||
|
, directory
|
||||||
|
, scotty
|
||||||
, sqlite-simple
|
, sqlite-simple
|
||||||
, text
|
, text
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -51,7 +55,9 @@ executable mtgsearch-exe
|
||||||
aeson
|
aeson
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, bytestring
|
, bytestring
|
||||||
|
, directory
|
||||||
, mtgsearch
|
, mtgsearch
|
||||||
|
, scotty
|
||||||
, sqlite-simple
|
, sqlite-simple
|
||||||
, text
|
, text
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
@ -68,7 +74,9 @@ test-suite mtgsearch-test
|
||||||
aeson
|
aeson
|
||||||
, base >=4.7 && <5
|
, base >=4.7 && <5
|
||||||
, bytestring
|
, bytestring
|
||||||
|
, directory
|
||||||
, mtgsearch
|
, mtgsearch
|
||||||
|
, scotty
|
||||||
, sqlite-simple
|
, sqlite-simple
|
||||||
, text
|
, text
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
|
@ -25,7 +25,8 @@ dependencies:
|
||||||
- text
|
- text
|
||||||
- bytestring
|
- bytestring
|
||||||
- sqlite-simple
|
- sqlite-simple
|
||||||
|
- scotty
|
||||||
|
- directory
|
||||||
|
|
||||||
ghc-options:
|
ghc-options:
|
||||||
- -Wall
|
- -Wall
|
||||||
|
|
29
src/Algorithm/Search.hs
Normal file
29
src/Algorithm/Search.hs
Normal file
|
@ -0,0 +1,29 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
module Algorithm.Search
|
||||||
|
( search
|
||||||
|
) where
|
||||||
|
import Database.SQLite.Simple
|
||||||
|
import Config (getDbPath)
|
||||||
|
import Web.Scotty.Internal.Types
|
||||||
|
import Control.Monad
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
|
||||||
|
data TestField = TestField Int T.Text deriving (Show)
|
||||||
|
|
||||||
|
instance FromRow TestField where
|
||||||
|
fromRow = TestField <$> field <*> field
|
||||||
|
|
||||||
|
instance ToRow TestField where
|
||||||
|
toRow (TestField id_ str) = toRow (id_, str)
|
||||||
|
|
||||||
|
search :: String -> IO String
|
||||||
|
search q = do
|
||||||
|
simpleSearch q
|
||||||
|
|
||||||
|
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)
|
|
@ -52,10 +52,7 @@ seedData = do
|
||||||
conn <- open dbPath
|
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)"
|
||||||
|
|
||||||
-- If d is Left, the JSON was malformed.
|
|
||||||
-- In that case, we report the error.
|
|
||||||
-- Otherwise, we perform the operation of
|
|
||||||
-- our choice. In this case, just print it.
|
|
||||||
case d of
|
case d of
|
||||||
Left err -> putStrLn err
|
Left err -> putStrLn err
|
||||||
Right ps -> insertCards conn ps
|
Right ps -> insertCards conn ps
|
||||||
|
|
18
src/Site/Host.hs
Normal file
18
src/Site/Host.hs
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}
|
||||||
|
module Site.Host
|
||||||
|
( host
|
||||||
|
) where
|
||||||
|
import Web.Scotty
|
||||||
|
|
||||||
|
import Algorithm.Search
|
||||||
|
import Control.Monad.IO.Class (MonadIO(liftIO))
|
||||||
|
import Data.Text.Lazy (pack)
|
||||||
|
|
||||||
|
host = scotty 3000 $ do
|
||||||
|
post "/api/req" $ do
|
||||||
|
query <- param "query"
|
||||||
|
result <- liftIO (search query)
|
||||||
|
html $ mconcat ["<h1>", pack result, "</h1>"]
|
||||||
|
get "/" $ file "src/Site/Static/index.html"
|
||||||
|
|
||||||
|
|
18
src/Site/Static/index.html
Normal file
18
src/Site/Static/index.html
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
<!DOCTYPE html>
|
||||||
|
<html>
|
||||||
|
<body>
|
||||||
|
|
||||||
|
<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>
|
||||||
|
|
||||||
|
|
||||||
|
<form method="POST" action="/api/req">
|
||||||
|
<input name="query"/>
|
||||||
|
<button type="submit">SHIP IT!</button>
|
||||||
|
</form>
|
||||||
|
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue