Abstract out select query construction
This commit is contained in:
parent
4df535f3c5
commit
f6936baae7
3 changed files with 157 additions and 59 deletions
103
src/Lib.hs
103
src/Lib.hs
|
|
@ -45,6 +45,7 @@ import Network.Wai.Logger
|
|||
import qualified Paths_tutor as PT
|
||||
import Search
|
||||
import SearchParser
|
||||
import Select
|
||||
import Servant
|
||||
( Description,
|
||||
Get,
|
||||
|
|
@ -315,64 +316,48 @@ status =
|
|||
|
||||
searchCards :: FilePath -> Maybe T.Text -> Maybe T.Text -> Maybe T.Text -> Handler [Card]
|
||||
searchCards dbFile q sortBy inCollection =
|
||||
liftIO results
|
||||
where
|
||||
search = parseQuery $ fromMaybe "" q
|
||||
|
||||
defaultOrderings :: [Query]
|
||||
defaultOrderings =
|
||||
[ "rarities.rarity_ord DESC",
|
||||
"length(cards.color_identity) DESC",
|
||||
[sql|CASE WHEN length(cards.color_identity) > 0 THEN '0'
|
||||
ELSE cards.color_identity END ASC|],
|
||||
"cards.name ASC"
|
||||
]
|
||||
|
||||
orderSql :: Query
|
||||
orderSql =
|
||||
"ORDER BY " <> case sortBy of
|
||||
Just "price" -> sqlJoin "," $ "CAST(COALESCE(card_prices.usd, card_prices.usd_foil) as decimal) DESC" : defaultOrderings
|
||||
_ -> sqlJoin "," defaultOrderings
|
||||
|
||||
joins :: [Query]
|
||||
joins =
|
||||
[ [sql|JOIN card_prices ON (cards.scryfall_id = card_prices.scryfall_id)
|
||||
AND card_prices.date = (SELECT value FROM vars WHERE key = :last_update_key)|],
|
||||
[sql|JOIN rarities ON (cards.rarity = rarities.rarity)|]
|
||||
]
|
||||
|
||||
joinSql :: Query
|
||||
joinSql = case inCollection of
|
||||
Just "no" -> sqlJoin "" joins
|
||||
_ -> sqlJoin "JOIN copies ON (cards.scryfall_id = copies.scryfall_id)" $ joins
|
||||
|
||||
results :: IO [Card]
|
||||
results = withConnection dbFile $ \conn ->
|
||||
liftIO $
|
||||
withConnection dbFile $ \conn ->
|
||||
queryNamed
|
||||
conn
|
||||
( sqlJoin
|
||||
" "
|
||||
[ [sql|
|
||||
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|],
|
||||
joinSql,
|
||||
orderSql,
|
||||
"LIMIT 10"
|
||||
]
|
||||
)
|
||||
[":last_update_key" := ("last_update" :: T.Text)]
|
||||
|
||||
sqlJoin :: Query -> [Query] -> Query
|
||||
sqlJoin joiner snippets =
|
||||
mconcat $ L.intercalate [joiner] [[s] | s <- snippets]
|
||||
(toQuery query)
|
||||
(selectParameters query)
|
||||
where
|
||||
baseQuery =
|
||||
selectSimple
|
||||
[ "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"
|
||||
]
|
||||
["cards"]
|
||||
<> join
|
||||
[sql|card_prices ON (cards.scryfall_id = card_prices.scryfall_id)
|
||||
AND card_prices.date = (SELECT value FROM vars WHERE key = :last_update_key)|]
|
||||
<> join "rarities ON (cards.rarity = rarities.rarity)"
|
||||
<> orderBy "rarities.rarity_ord DESC"
|
||||
<> orderBy "length(cards.color_identity) DESC"
|
||||
<> orderBy
|
||||
[sql|CASE WHEN length(cards.color_identity) > 0 THEN '0'
|
||||
ELSE cards.color_identity END ASC|]
|
||||
<> orderBy "cards.name ASC"
|
||||
<> parameter ":last_update_key" ("last_update" :: T.Text)
|
||||
<> limit 10
|
||||
query =
|
||||
mconcat $ catMaybes
|
||||
[ case sortBy of
|
||||
Just "price" -> Just $ orderBy "CAST(COALESCE(card_prices.usd, card_prices.usd_foil) as decimal) DESC"
|
||||
_ -> Nothing,
|
||||
Just baseQuery,
|
||||
case inCollection of
|
||||
Just "no" -> Nothing
|
||||
_ -> Just $ join "copies ON (cards.scryfall_id = copies.scryfall_id)"
|
||||
]
|
||||
|
|
|
|||
112
src/Select.hs
Normal file
112
src/Select.hs
Normal file
|
|
@ -0,0 +1,112 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Select
|
||||
( toQuery,
|
||||
selectSimple,
|
||||
selectWhere,
|
||||
selectParameters,
|
||||
column,
|
||||
table,
|
||||
join,
|
||||
where_,
|
||||
orderBy,
|
||||
limit,
|
||||
limitOffset,
|
||||
parameter,
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad (unless)
|
||||
import Data.List
|
||||
import Data.Map
|
||||
import Data.Maybe
|
||||
import Data.String
|
||||
import Data.Text
|
||||
import Database.SQLite.Simple
|
||||
import Database.SQLite.Simple.Ok
|
||||
import Search
|
||||
|
||||
data Select a = Select
|
||||
{ selectColumns :: [a],
|
||||
selectTables :: [a],
|
||||
selectJoins :: [a],
|
||||
selectCriteria :: [a],
|
||||
selectOrdering :: [a],
|
||||
selectLimit :: Maybe Int,
|
||||
selectOffset :: Maybe Int,
|
||||
selectParameters :: [NamedParam]
|
||||
}
|
||||
|
||||
instance Semigroup (Select a) where
|
||||
(<>) a b =
|
||||
Select
|
||||
(selectColumns a <> selectColumns b)
|
||||
(selectTables a <> selectTables b)
|
||||
(selectJoins a <> selectJoins b)
|
||||
(selectCriteria a <> selectCriteria b)
|
||||
(selectOrdering a <> selectOrdering a)
|
||||
(pickLast (selectLimit a) (selectLimit b))
|
||||
(pickLast (selectOffset a) (selectOffset b))
|
||||
(selectParameters a <> selectParameters b)
|
||||
where
|
||||
pickLast _ (Just b) = Just b
|
||||
pickLast a Nothing = a
|
||||
|
||||
instance Monoid (Select a) where
|
||||
mempty = selectSimple [] []
|
||||
|
||||
toQuery :: (Monoid a, Data.String.IsString a) => Select a -> a
|
||||
toQuery select =
|
||||
sqlJoin
|
||||
" "
|
||||
$ [ "SELECT",
|
||||
sqlColumns,
|
||||
"FROM",
|
||||
sqlTables
|
||||
]
|
||||
<> catMaybes
|
||||
[ sqlJoins,
|
||||
sqlWhere,
|
||||
sqlOrdering,
|
||||
sqlLimitOffset
|
||||
]
|
||||
where
|
||||
sqlColumns = sqlJoin ", " $ selectColumns select
|
||||
sqlTables = sqlJoin ", " $ selectTables select
|
||||
sqlJoins = case selectJoins select of
|
||||
[] -> Nothing
|
||||
xs -> Just $ sqlJoin " " $ ["JOIN " <> x | x <- xs]
|
||||
sqlWhere = case selectCriteria select of
|
||||
[] -> Nothing
|
||||
xs -> Just $ "WHERE " <> sqlJoin " AND " xs
|
||||
sqlOrdering = case selectOrdering select of
|
||||
[] -> Nothing
|
||||
xs -> Just $ "ORDER BY " <> sqlJoin ", " xs
|
||||
sqlLimitOffset = case (selectLimit select, selectOffset select) of
|
||||
(Just l, Just o) -> Just "LIMIT :__limit, :__offset"
|
||||
(Just l, Nothing) -> Just "LIMIT :__limit"
|
||||
_ -> Nothing
|
||||
|
||||
sqlJoin :: (Monoid a, Data.String.IsString a) => a -> [a] -> a
|
||||
sqlJoin joiner snippets =
|
||||
mconcat $ Data.List.intercalate [joiner] [[s] | s <- snippets]
|
||||
|
||||
selectSimple columns tables = Select columns tables [] [] [] Nothing Nothing []
|
||||
|
||||
selectWhere columns tables criteria = Select columns tables criteria [] [] Nothing Nothing []
|
||||
|
||||
column x = selectSimple [x] []
|
||||
|
||||
table x = selectSimple [] [x]
|
||||
|
||||
where_ x = selectWhere [] [] [x]
|
||||
|
||||
join x = Select [] [] [x] [] [] Nothing Nothing []
|
||||
|
||||
orderBy x = Select [] [] [] [] [x] Nothing Nothing []
|
||||
|
||||
limit x = Select [] [] [] [] [] (Just x) Nothing [":__limit" := x]
|
||||
|
||||
limitOffset x y = Select [] [] [] [] [] (Just x) (Just y) [":__limit" := x, ":__offset" := y]
|
||||
|
||||
parameter name value = Select [] [] [] [] [] Nothing Nothing [name := value]
|
||||
|
|
@ -26,6 +26,7 @@ library
|
|||
Lib
|
||||
Search
|
||||
SearchParser
|
||||
Select
|
||||
other-modules:
|
||||
Paths_tutor
|
||||
hs-source-dirs:
|
||||
|
|
|
|||
Loading…
Reference in a new issue