Move the API definition into its own module
This commit is contained in:
parent
6e1ea5c910
commit
384affe29e
2 changed files with 227 additions and 247 deletions
250
src/Tutor.hs
250
src/Tutor.hs
|
|
@ -1,255 +1,11 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Tutor
|
||||
( startApp,
|
||||
app,
|
||||
)
|
||||
module Tutor ( startApp )
|
||||
where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Aeson
|
||||
import Data.Aeson.TH
|
||||
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.Version (showVersion)
|
||||
import GHC.Generics
|
||||
import Network.Wai
|
||||
import Network.Wai.Handler.Warp
|
||||
import Network.Wai.Logger
|
||||
import qualified Paths_tutor as PT
|
||||
import Servant
|
||||
( Description,
|
||||
Get,
|
||||
Handler,
|
||||
JSON,
|
||||
Proxy (..),
|
||||
QueryParam',
|
||||
Raw,
|
||||
Server,
|
||||
Summary,
|
||||
serve,
|
||||
serveDirectoryFileServer,
|
||||
type (:<|>) (..),
|
||||
type (:>),
|
||||
)
|
||||
import Servant.OpenApi (HasOpenApi (toOpenApi))
|
||||
import Tutor.Card
|
||||
import Tutor.Database
|
||||
import Tutor.Search
|
||||
import Tutor.SearchParser
|
||||
import Tutor.Select
|
||||
|
||||
data Status = Status
|
||||
{apiVersion :: T.Text}
|
||||
deriving (Generic, Typeable)
|
||||
|
||||
instance FromJSON Status
|
||||
|
||||
instance ToJSON Status
|
||||
|
||||
instance ToSchema Status
|
||||
|
||||
instance FromJSON Prices
|
||||
|
||||
instance ToJSON Prices
|
||||
|
||||
instance FromJSON Card
|
||||
|
||||
instance ToJSON Card
|
||||
|
||||
instance ToSchema Prices
|
||||
|
||||
instance ToSchema Card
|
||||
|
||||
type GetStatus =
|
||||
Summary "Get API Status"
|
||||
:> Description "Get the current running API version."
|
||||
:> "api"
|
||||
:> "status"
|
||||
:> Get '[JSON] Status
|
||||
|
||||
type SearchCards =
|
||||
Summary "Search for cards in a collection"
|
||||
:> Description
|
||||
"Text in the query string will be used to filter cards having that text in their \n\
|
||||
\name. Additionally, the keyword expressions below can be used to search for \n\
|
||||
\cards with certain properties. \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\### Examples \n\
|
||||
\ \n\
|
||||
\`bolt` \n\
|
||||
\: Find all cards with \"bolt\" in the name \n\
|
||||
\ \n\
|
||||
\`\"God of\"` \n\
|
||||
\: Find all cards with \"God of\" in the name \n\
|
||||
\ \n\
|
||||
\`t:legendary t:creature c:jund` \n\
|
||||
\: Find all legendary creatures with a color \n\
|
||||
\ identity of red/blue/green \n\
|
||||
\ \n\
|
||||
\`color<=ubg` \n\
|
||||
\: Find all spells that are blue, black, green, or any \n\
|
||||
\ combination thereof. \n\
|
||||
\ \n\
|
||||
\`color:red set:stx rarity>=rare` \n\
|
||||
\: Find all red cards in Strixhaven that are \n\
|
||||
\ rare or mythic \n\
|
||||
\ \n\
|
||||
\`t:enchantment o:\"enters the battlefield\"` \n\
|
||||
\: Find all enchantments with ETB \n\
|
||||
\ effects \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\### Keywords \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\#### Colors \n\
|
||||
\ \n\
|
||||
\Keywords \n\
|
||||
\: `c`, `color` \n\
|
||||
\ \n\
|
||||
\Operators \n\
|
||||
\: `:` (matches), `>=` (greater than or equal to), `<=` (less than \n\
|
||||
\ or equal to) \n\
|
||||
\ \n\
|
||||
\Matches cards of the chosen color or colors. \n\
|
||||
\ \n\
|
||||
\Single colors \n\
|
||||
\: `w` or `white`, `u` or `blue`, `b` or `black, =g` or `green`, `r` or `red` \n\
|
||||
\ \n\
|
||||
\Any combination of abbreviated single colors \n\
|
||||
\: e.g.: `rg`, `uw`, or `wubgr` \n\
|
||||
\ \n\
|
||||
\Ravnican guilds \n\
|
||||
\: `boros` (white/red), `golgari` (green/black), `selesnya` \n\
|
||||
\ (green/white), `dimir` (blue/black), `orzhov` (white/black), `izzet` \n\
|
||||
\ (blue/red), `gruul` (red/green), `azorius` (white/blue), `rakdos` (black/red), \n\
|
||||
\ `simic` (green/blue) \n\
|
||||
\ \n\
|
||||
\Alaran shards \n\
|
||||
\: `bant` (white/green/blue), `esper` (blue/white/black), \n\
|
||||
\ `grixis` (black/blue/red), `jund` (red/blue/green), `naya` (green/red/white) \n\
|
||||
\ \n\
|
||||
\Tarkirian wedges \n\
|
||||
\: `abzan` (white/black/green), `jeskai` (white/blue/red), \n\
|
||||
\ `sultai` (blue/black/green), `mardu` (white/black/red), `temur` \n\
|
||||
\ (blue/red/green) \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\#### Sets \n\
|
||||
\ \n\
|
||||
\Keywords \n\
|
||||
\: `s`, `set`, `e`, `expansion` \n\
|
||||
\ \n\
|
||||
\Operators \n\
|
||||
\: `:` (matches) \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\#### Rarity \n\
|
||||
\ \n\
|
||||
\Keywords \n\
|
||||
\: `r`, `rarity` \n\
|
||||
\ \n\
|
||||
\Operators \n\
|
||||
\: `:` (matches), `>=` (greater than or equal to), `<=` (less than \n\
|
||||
\ or equal to) \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\#### Type \n\
|
||||
\ \n\
|
||||
\Keywords \n\
|
||||
\: `t`, `type` \n\
|
||||
\ \n\
|
||||
\Operators \n\
|
||||
\: `:` (matches) \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\#### Oracle Text \n\
|
||||
\ \n\
|
||||
\Keywords \n\
|
||||
\: `o`, `oracle` \n\
|
||||
\ \n\
|
||||
\Operators \n\
|
||||
\: `:` (matches)"
|
||||
:> "search"
|
||||
:> QueryParam' '[Description "Query string"] "q" T.Text
|
||||
:> QueryParam' '[Description "Sorting method"] "sort_by" T.Text
|
||||
:> QueryParam' '[Description "Search across collection or all cards"] "in_collection" T.Text
|
||||
:> Get '[JSON] [Card]
|
||||
|
||||
type TutorAPI =
|
||||
GetStatus
|
||||
:<|> SearchCards
|
||||
|
||||
type DocsAPI =
|
||||
"api" :> "openapi.json" :> Get '[JSON] OpenApi
|
||||
|
||||
type ElmAPI = Raw
|
||||
|
||||
type API = TutorAPI :<|> DocsAPI :<|> ElmAPI
|
||||
import Servant (serve)
|
||||
import Tutor.Api (app)
|
||||
|
||||
startApp :: FilePath -> IO ()
|
||||
startApp dbFile = withStdoutLogger $ \logger ->
|
||||
runSettings (setPort 8080 $ setLogger logger $ defaultSettings) (app dbFile)
|
||||
|
||||
app :: FilePath -> Application
|
||||
app dbFile = serve api $ server dbFile
|
||||
|
||||
tutorAPI :: Proxy TutorAPI
|
||||
tutorAPI = Proxy
|
||||
|
||||
api :: Proxy API
|
||||
api = Proxy
|
||||
|
||||
openapi :: OpenApi
|
||||
openapi =
|
||||
toOpenApi tutorAPI
|
||||
& info . title .~ "Tutor API"
|
||||
& info . version .~ packageVersion
|
||||
& info . description ?~ "An API for searching a Magic: The Gathering card collection."
|
||||
& info . license ?~ ("MIT" & url ?~ URL "http://mit.com")
|
||||
|
||||
tutorServer :: FilePath -> Server TutorAPI
|
||||
tutorServer dbFile = status :<|> searchCards dbFile
|
||||
where
|
||||
searchCards :: FilePath -> Maybe T.Text -> Maybe T.Text -> Maybe T.Text -> Handler [Card]
|
||||
searchCards dbFile q sortBy inCollection =
|
||||
liftIO $ Tutor.Database.searchCards dbFile q sortBy inCollection
|
||||
|
||||
|
||||
docsServer :: Server DocsAPI
|
||||
docsServer = return openapi
|
||||
|
||||
elmServer :: Server ElmAPI
|
||||
elmServer = serveDirectoryFileServer "www/public"
|
||||
|
||||
server :: FilePath -> Server API
|
||||
server dbFile = tutorServer dbFile :<|> docsServer :<|> elmServer
|
||||
|
||||
packageVersion :: T.Text
|
||||
packageVersion = T.pack $ showVersion PT.version
|
||||
|
||||
status :: Handler Status
|
||||
status =
|
||||
return
|
||||
Status
|
||||
{ apiVersion = packageVersion
|
||||
}
|
||||
|
||||
|
|
|
|||
224
src/Tutor/Api.hs
Normal file
224
src/Tutor/Api.hs
Normal file
|
|
@ -0,0 +1,224 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Tutor.Api (app) where
|
||||
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Lens
|
||||
import Data.Aeson (FromJSON, ToJSON)
|
||||
import Data.OpenApi
|
||||
( HasDescription (description),
|
||||
HasInfo (info),
|
||||
HasLicense (license),
|
||||
HasTitle (title),
|
||||
HasUrl (url),
|
||||
HasVersion (version),
|
||||
OpenApi,
|
||||
ToSchema,
|
||||
URL (URL),
|
||||
)
|
||||
import Data.Version (showVersion)
|
||||
import qualified Data.Text as T
|
||||
import Data.Typeable (Typeable)
|
||||
import GHC.Generics (Generic)
|
||||
import qualified Paths_tutor as PT
|
||||
import Servant
|
||||
import Servant.OpenApi (HasOpenApi (toOpenApi))
|
||||
import Tutor.Card
|
||||
import Tutor.Database
|
||||
|
||||
data Status = Status
|
||||
{apiVersion :: T.Text}
|
||||
deriving (Generic, Typeable)
|
||||
|
||||
instance FromJSON Status
|
||||
|
||||
instance ToJSON Status
|
||||
|
||||
instance ToSchema Status
|
||||
|
||||
instance FromJSON Prices
|
||||
|
||||
instance ToJSON Prices
|
||||
|
||||
instance FromJSON Card
|
||||
|
||||
instance ToJSON Card
|
||||
|
||||
instance ToSchema Prices
|
||||
|
||||
instance ToSchema Card
|
||||
|
||||
type GetStatus =
|
||||
Summary "Get API Status"
|
||||
:> Description "Get the current running API version."
|
||||
:> "api"
|
||||
:> "status"
|
||||
:> Get '[JSON] Status
|
||||
|
||||
type SearchCards =
|
||||
Summary "Search for cards in a collection"
|
||||
:> Description
|
||||
"Text in the query string will be used to filter cards having that text in their \n\
|
||||
\name. Additionally, the keyword expressions below can be used to search for \n\
|
||||
\cards with certain properties. \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\### Examples \n\
|
||||
\ \n\
|
||||
\`bolt` \n\
|
||||
\: Find all cards with \"bolt\" in the name \n\
|
||||
\ \n\
|
||||
\`\"God of\"` \n\
|
||||
\: Find all cards with \"God of\" in the name \n\
|
||||
\ \n\
|
||||
\`t:legendary t:creature c:jund` \n\
|
||||
\: Find all legendary creatures with a color \n\
|
||||
\ identity of red/blue/green \n\
|
||||
\ \n\
|
||||
\`color<=ubg` \n\
|
||||
\: Find all spells that are blue, black, green, or any \n\
|
||||
\ combination thereof. \n\
|
||||
\ \n\
|
||||
\`color:red set:stx rarity>=rare` \n\
|
||||
\: Find all red cards in Strixhaven that are \n\
|
||||
\ rare or mythic \n\
|
||||
\ \n\
|
||||
\`t:enchantment o:\"enters the battlefield\"` \n\
|
||||
\: Find all enchantments with ETB \n\
|
||||
\ effects \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\### Keywords \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\#### Colors \n\
|
||||
\ \n\
|
||||
\Keywords \n\
|
||||
\: `c`, `color` \n\
|
||||
\ \n\
|
||||
\Operators \n\
|
||||
\: `:` (matches), `>=` (greater than or equal to), `<=` (less than \n\
|
||||
\ or equal to) \n\
|
||||
\ \n\
|
||||
\Matches cards of the chosen color or colors. \n\
|
||||
\ \n\
|
||||
\Single colors \n\
|
||||
\: `w` or `white`, `u` or `blue`, `b` or `black, =g` or `green`, `r` or `red` \n\
|
||||
\ \n\
|
||||
\Any combination of abbreviated single colors \n\
|
||||
\: e.g.: `rg`, `uw`, or `wubgr` \n\
|
||||
\ \n\
|
||||
\Ravnican guilds \n\
|
||||
\: `boros` (white/red), `golgari` (green/black), `selesnya` \n\
|
||||
\ (green/white), `dimir` (blue/black), `orzhov` (white/black), `izzet` \n\
|
||||
\ (blue/red), `gruul` (red/green), `azorius` (white/blue), `rakdos` (black/red), \n\
|
||||
\ `simic` (green/blue) \n\
|
||||
\ \n\
|
||||
\Alaran shards \n\
|
||||
\: `bant` (white/green/blue), `esper` (blue/white/black), \n\
|
||||
\ `grixis` (black/blue/red), `jund` (red/blue/green), `naya` (green/red/white) \n\
|
||||
\ \n\
|
||||
\Tarkirian wedges \n\
|
||||
\: `abzan` (white/black/green), `jeskai` (white/blue/red), \n\
|
||||
\ `sultai` (blue/black/green), `mardu` (white/black/red), `temur` \n\
|
||||
\ (blue/red/green) \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\#### Sets \n\
|
||||
\ \n\
|
||||
\Keywords \n\
|
||||
\: `s`, `set`, `e`, `expansion` \n\
|
||||
\ \n\
|
||||
\Operators \n\
|
||||
\: `:` (matches) \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\#### Rarity \n\
|
||||
\ \n\
|
||||
\Keywords \n\
|
||||
\: `r`, `rarity` \n\
|
||||
\ \n\
|
||||
\Operators \n\
|
||||
\: `:` (matches), `>=` (greater than or equal to), `<=` (less than \n\
|
||||
\ or equal to) \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\#### Type \n\
|
||||
\ \n\
|
||||
\Keywords \n\
|
||||
\: `t`, `type` \n\
|
||||
\ \n\
|
||||
\Operators \n\
|
||||
\: `:` (matches) \n\
|
||||
\ \n\
|
||||
\ \n\
|
||||
\#### Oracle Text \n\
|
||||
\ \n\
|
||||
\Keywords \n\
|
||||
\: `o`, `oracle` \n\
|
||||
\ \n\
|
||||
\Operators \n\
|
||||
\: `:` (matches)"
|
||||
:> "search"
|
||||
:> QueryParam' '[Description "Query string"] "q" T.Text
|
||||
:> QueryParam' '[Description "Sorting method"] "sort_by" T.Text
|
||||
:> QueryParam' '[Description "Search across collection or all cards"] "in_collection" T.Text
|
||||
:> Get '[JSON] [Card]
|
||||
|
||||
type TutorAPI =
|
||||
GetStatus
|
||||
:<|> SearchCards
|
||||
|
||||
type DocsAPI =
|
||||
"api" :> "openapi.json" :> Get '[JSON] OpenApi
|
||||
|
||||
type ElmAPI = Raw
|
||||
|
||||
type API = TutorAPI :<|> DocsAPI :<|> ElmAPI
|
||||
|
||||
tutorAPI :: Proxy TutorAPI
|
||||
tutorAPI = Proxy
|
||||
|
||||
api :: Proxy API
|
||||
api = Proxy
|
||||
|
||||
openapi :: OpenApi
|
||||
openapi =
|
||||
toOpenApi tutorAPI
|
||||
& info . title .~ "Tutor API"
|
||||
& info . version .~ packageVersion
|
||||
& info . description ?~ "An API for searching a Magic: The Gathering card collection."
|
||||
& info . license ?~ ("MIT" & url ?~ URL "http://mit.com")
|
||||
|
||||
tutorServer :: FilePath -> Server TutorAPI
|
||||
tutorServer dbFile = status :<|> searchCards dbFile
|
||||
where
|
||||
searchCards :: FilePath -> Maybe T.Text -> Maybe T.Text -> Maybe T.Text -> Handler [Card]
|
||||
searchCards dbFile q sortBy inCollection =
|
||||
liftIO $ Tutor.Database.searchCards dbFile q sortBy inCollection
|
||||
|
||||
docsServer :: Server DocsAPI
|
||||
docsServer = return openapi
|
||||
|
||||
elmServer :: Server ElmAPI
|
||||
elmServer = serveDirectoryFileServer "www/public"
|
||||
|
||||
server :: FilePath -> Server API
|
||||
server dbFile = tutorServer dbFile :<|> docsServer :<|> elmServer
|
||||
|
||||
packageVersion :: T.Text
|
||||
packageVersion = T.pack $ showVersion PT.version
|
||||
|
||||
status :: Handler Status
|
||||
status =
|
||||
return
|
||||
Status
|
||||
{ apiVersion = packageVersion
|
||||
}
|
||||
|
||||
app :: FilePath -> Application
|
||||
app dbFile = serve api $ server dbFile
|
||||
Loading…
Reference in a new issue