Load cards from the sqlite database

app/Main.hs

@@ -1,6 +1,10 @@
 module Main where
 
 import Lib
+import Data.Maybe
+import System.Environment
 
 main :: IO ()
-main = startApp
+main = do
+  dbFile <- lookupEnv "TUTOR_DATABASE"
+  startApp (fromMaybe "tutor.db" dbFile)

package.yaml

@@ -28,6 +28,7 @@ dependencies:
 - parsec-extra
 - servant-openapi3
 - servant-server
+- sqlite-simple
 - text
 - uuid
 - wai

src/Lib.hs

@@ -11,19 +11,36 @@ module Lib
 where
 
 import Control.Lens
+import qualified Control.Lens as Database.SQLite
+import Control.Monad.IO.Class
 import Data.Aeson
 import Data.Aeson.TH
 import Data.Maybe
-import Data.OpenApi hiding (Server, name, server)
+import Data.OpenApi
+  ( HasDescription (description),
+    HasInfo (info),
+    HasLicense (license),
+    HasTitle (title),
+    HasUrl (url),
+    HasVersion (version),
+    OpenApi,
+    ToSchema,
+    URL (URL),
+  )
 import qualified Data.Text as T
 import Data.Typeable (Typeable)
 import Data.UUID
 import Data.Version (showVersion)
+import Database.SQLite.Simple
+import Database.SQLite.Simple.FromField
+import Database.SQLite.Simple.Internal
+import Database.SQLite.Simple.Ok
 import GHC.Generics
 import Network.Wai
 import Network.Wai.Handler.Warp
 import Network.Wai.Logger
 import qualified Paths_tutor as PT
+import Search
 import Servant
   ( Description,
     Get,
@@ -41,6 +58,10 @@ import Servant
   )
 import Servant.OpenApi (HasOpenApi (toOpenApi))
 
+instance FromField UUID where
+  fromField (Field (SQLText txt) _) = Ok $ fromMaybe nil $ fromText txt
+  fromField f = returnError ConversionFailed f "need a text"
+
 data Status = Status
   {apiVersion :: T.Text}
   deriving (Generic, Typeable)
@@ -84,10 +105,44 @@ instance ToJSON Card
 
 instance ToSchema Card
 
+instance FromRow Card where
+  fromRow = do
+    scryfall_id <- field
+    name <- field
+    set_code <- field
+    collector_number <- field
+    rarity <- field
+    color_identity <- field
+    oracle_text <- field
+    price_usd <- field
+    price_usd_foil <- field
+    price_eur <- field
+    price_eur_foil <- field
+    price_tix <- field
+    return $
+      Card
+        { scryfall_id = scryfall_id,
+          name = name,
+          set_code = set_code,
+          collector_number = collector_number,
+          rarity = rarity,
+          color_identity = color_identity,
+          oracle_text = oracle_text,
+          prices =
+            Prices
+              { usd = price_usd,
+                usd_foil = price_usd_foil,
+                eur = price_eur,
+                eur_foil = price_eur_foil,
+                tix = price_tix
+              }
+        }
+
 type GetStatus =
   Summary "Get API Status"
     :> Description "Get the current running API version."
-    :> "api" :> "status"
+    :> "api"
+    :> "status"
     :> Get '[JSON] Status
 
 type SearchCards =
@@ -209,12 +264,12 @@ type ElmAPI = Raw
 
 type API = TutorAPI :<|> DocsAPI :<|> ElmAPI
 
-startApp :: IO ()
-startApp = withStdoutLogger $ \logger ->
-  runSettings (setPort 8080 $ setLogger logger $ defaultSettings) app
+startApp :: FilePath -> IO ()
+startApp dbFile = withStdoutLogger $ \logger ->
+  runSettings (setPort 8080 $ setLogger logger $ defaultSettings) (app dbFile)
 
-app :: Application
-app = serve api server
+app :: FilePath -> Application
+app dbFile = serve api $ server dbFile
 
 tutorAPI :: Proxy TutorAPI
 tutorAPI = Proxy
@@ -230,8 +285,8 @@ openapi =
     & info . description ?~ "An API for searching a Magic: The Gathering card collection."
     & info . license ?~ ("MIT" & url ?~ URL "http://mit.com")
 
-tutorServer :: Server TutorAPI
-tutorServer = status :<|> cards
+tutorServer :: FilePath -> Server TutorAPI
+tutorServer dbFile = status :<|> searchCards dbFile
 
 docsServer :: Server DocsAPI
 docsServer = return openapi
@@ -239,8 +294,8 @@ docsServer = return openapi
 elmServer :: Server ElmAPI
 elmServer = serveDirectoryFileServer "www/public"
 
-server :: Server API
-server = tutorServer :<|> docsServer :<|> elmServer
+server :: FilePath -> Server API
+server dbFile = tutorServer dbFile :<|> docsServer :<|> elmServer
 
 packageVersion :: T.Text
 packageVersion = T.pack $ showVersion PT.version
@@ -307,3 +362,31 @@ cards q =
               }
         }
     ]
+
+searchCards :: FilePath -> Maybe T.Text -> Handler [Card]
+searchCards dbFile q =
+  liftIO results
+  where
+    search = Search.parse $ fromMaybe "" q
+
+    results :: IO [Card]
+    results = withConnection dbFile $ \conn ->
+      queryNamed
+        conn
+        "SELECT cards.scryfall_id, \
+        \       cards.name, \
+        \       cards.set_code, \
+        \       cards.collector_number, \
+        \       cards.rarity, \
+        \       cards.color_identity, \
+        \       cards.oracle_text, \
+        \       card_prices.usd, \
+        \       card_prices.usd_foil, \
+        \       card_prices.eur, \
+        \       card_prices.eur_foil, \
+        \       card_prices.tix \
+        \FROM cards \
+        \JOIN card_prices ON (cards.scryfall_id = card_prices.scryfall_id) \
+        \     AND card_prices.date = (SELECT value FROM vars WHERE key = :last_update_key) \
+        \LIMIT 5"
+        [":last_update_key" := ("last_update" :: T.Text)]

tutor.cabal

@@ -39,6 +39,7 @@ library
     , parsec-extra
     , servant-openapi3
     , servant-server
+    , sqlite-simple
     , text
     , uuid
     , wai
@@ -63,6 +64,7 @@ executable tutor-exe
     , parsec-extra
     , servant-openapi3
     , servant-server
+    , sqlite-simple
     , text
     , tutor
     , uuid
@@ -94,6 +96,7 @@ test-suite tutor-test
     , parsec-extra
     , servant-openapi3
     , servant-server
+    , sqlite-simple
     , text
     , tutor
     , uuid