WIP: more clean query functions
This commit is contained in:
+39
-18
@@ -1,4 +1,13 @@
|
|||||||
module PgQuery where
|
module PgQuery (
|
||||||
|
CompleteQuery
|
||||||
|
, QualifiedTable
|
||||||
|
, limitT
|
||||||
|
, whereT
|
||||||
|
, orderT
|
||||||
|
, countRows
|
||||||
|
, asJsonWithCount
|
||||||
|
, orderParse
|
||||||
|
) where
|
||||||
|
|
||||||
import RangeQuery
|
import RangeQuery
|
||||||
import Database.PostgreSQL.Simple
|
import Database.PostgreSQL.Simple
|
||||||
@@ -7,26 +16,18 @@ import qualified Data.ByteString.Char8 as BS
|
|||||||
import Data.ByteString.Search (split)
|
import Data.ByteString.Search (split)
|
||||||
import qualified Network.HTTP.Types.URI as Net
|
import qualified Network.HTTP.Types.URI as Net
|
||||||
import Blaze.ByteString.Builder.ByteString (fromByteString)
|
import Blaze.ByteString.Builder.ByteString (fromByteString)
|
||||||
import Data.Text hiding (map, intersperse, split)
|
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe, mapMaybe)
|
||||||
import Data.Functor ( (<$>) )
|
import Data.Functor ( (<$>) )
|
||||||
|
import Control.Monad (join)
|
||||||
import Data.String.Conversions (cs)
|
import Data.String.Conversions (cs)
|
||||||
import qualified Data.List as L
|
import qualified Data.List as L
|
||||||
|
|
||||||
data RangedResult = RangedResult {
|
|
||||||
rrFrom :: Int
|
|
||||||
, rrTo :: Int
|
|
||||||
, rrTotal :: Int
|
|
||||||
, rrBody :: BS.ByteString
|
|
||||||
} deriving (Show)
|
|
||||||
|
|
||||||
type CompleteQuery = (Query, [Action])
|
type CompleteQuery = (Query, [Action])
|
||||||
type CompleteQueryT = CompleteQuery -> CompleteQuery
|
type CompleteQueryT = CompleteQuery -> CompleteQuery
|
||||||
type JsonQuery = CompleteQuery
|
|
||||||
data QualifiedTable = QualifiedTable {
|
data QualifiedTable = QualifiedTable {
|
||||||
qtSchema :: Text
|
qtSchema :: BS.ByteString
|
||||||
, qtName :: Text
|
, qtName :: BS.ByteString
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
data OrderTerm = OrderTerm {
|
data OrderTerm = OrderTerm {
|
||||||
@@ -48,7 +49,7 @@ whereT params q =
|
|||||||
else q <> conjunction
|
else q <> conjunction
|
||||||
where
|
where
|
||||||
cols = [ col | col <- params, fst col `notElem` ["order"] ]
|
cols = [ col | col <- params, fst col `notElem` ["order"] ]
|
||||||
conjunction = mconcat $ L.intersperse (" and ",[]) (map wherePred cols)
|
conjunction = mconcat $ L.intersperse andq (map wherePred cols)
|
||||||
|
|
||||||
orderT :: [OrderTerm] -> CompleteQueryT
|
orderT :: [OrderTerm] -> CompleteQueryT
|
||||||
orderT ts q =
|
orderT ts q =
|
||||||
@@ -56,15 +57,23 @@ orderT ts q =
|
|||||||
then q
|
then q
|
||||||
else q <> (" order by ",[]) <> clause
|
else q <> (" order by ",[]) <> clause
|
||||||
where
|
where
|
||||||
clause = mconcat $ L.intersperse (", ",[]) (map queryTerm ts)
|
clause = mconcat $ L.intersperse commaq (map queryTerm ts)
|
||||||
queryTerm :: OrderTerm -> CompleteQuery
|
queryTerm :: OrderTerm -> CompleteQuery
|
||||||
queryTerm t =
|
queryTerm t =
|
||||||
(" ? ? ",
|
(" ? ? ",
|
||||||
[EscapeIdentifier (otTerm t), Plain (fromByteString $ otDirection t)]
|
[EscapeIdentifier (otTerm t), Plain (fromByteString $ otDirection t)]
|
||||||
)
|
)
|
||||||
-- order = fromMaybe "" $ join (lookup "order" qs)
|
|
||||||
-- terms = mapMaybe parseOrderTerm $ splitOn "," $ cs order
|
countRows :: QualifiedTable -> CompleteQuery
|
||||||
-- termPred = mconcat $ L.intersperse ", " (map orderTermSql terms)
|
countRows t =
|
||||||
|
("select count(1) from ?.?",
|
||||||
|
[EscapeIdentifier (qtSchema t), EscapeIdentifier (qtName t)])
|
||||||
|
|
||||||
|
asJsonWithCount :: CompleteQueryT
|
||||||
|
asJsonWithCount (sql, params) = (
|
||||||
|
"count(t), array_to_json(array_agg(row_to_json(t))) from (" <> sql <> ") t"
|
||||||
|
, params
|
||||||
|
)
|
||||||
|
|
||||||
wherePred :: Net.QueryItem -> CompleteQuery
|
wherePred :: Net.QueryItem -> CompleteQuery
|
||||||
wherePred (col, predicate) =
|
wherePred (col, predicate) =
|
||||||
@@ -82,6 +91,12 @@ wherePred (col, predicate) =
|
|||||||
"neq" -> "<>"
|
"neq" -> "<>"
|
||||||
_ -> "="
|
_ -> "="
|
||||||
|
|
||||||
|
orderParse :: Net.Query -> [OrderTerm]
|
||||||
|
orderParse q =
|
||||||
|
mapMaybe orderParseTerm . split "," $ cs order
|
||||||
|
where
|
||||||
|
order = fromMaybe "" $ join (lookup "order" q)
|
||||||
|
|
||||||
orderParseTerm :: BS.ByteString -> Maybe OrderTerm
|
orderParseTerm :: BS.ByteString -> Maybe OrderTerm
|
||||||
orderParseTerm s =
|
orderParseTerm s =
|
||||||
case split "." s of
|
case split "." s of
|
||||||
@@ -91,3 +106,9 @@ orderParseTerm s =
|
|||||||
if d == "asc" then "asc" else "desc"
|
if d == "asc" then "asc" else "desc"
|
||||||
else Nothing
|
else Nothing
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
|
commaq :: CompleteQuery
|
||||||
|
commaq = (", ", [])
|
||||||
|
|
||||||
|
andq :: CompleteQuery
|
||||||
|
andq = (" and ", [])
|
||||||
|
|||||||
Reference in New Issue
Block a user