jimmy/postgrest
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Protolude completion in library and executable (#697)

Browse Source
This commit is contained in:
Diogo Biazus
2016-08-21 15:10:19 -07:00
committed by Joe Nelson
parent 298753d59e
commit 6f737056a2
13 changed files with 149 additions and 177 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/PostgREST/QueryBuilder.hs
+21 -25
View File
@@ -33,20 +33,14 @@ import qualified Hasql.Encoders as HE
import qualified Hasql.Decoders as HD
import qualified Data.Aeson as JSON
import Data.Int (Int64)
import PostgREST.RangeQuery (NonnegRange, rangeLimit, rangeOffset, allRange)
import Control.Error (note, fromMaybe)
import Control.Error (note)
import Data.Functor.Contravariant (contramap)
import qualified Data.HashMap.Strict as HM
import Data.List (find)
import Data.Monoid ((<>))
import Data.Text (Text, intercalate, unwords, replace, isInfixOf, toLower, split)
import Data.Text (intercalate, unwords, replace, isInfixOf, toLower, split)
import qualified Data.Text as T (map, takeWhile, null)
import qualified Data.Text.Encoding as T
import Data.String.Conversions (cs)
import Control.Applicative ((<|>))
import Control.Monad (replicateM)
import Data.Tree (Tree(..))
import qualified Data.Vector as V
import PostgREST.Types
@@ -58,7 +52,7 @@ import Data.Scientific ( FPFormat (..)
, formatScientific
, isInteger
)
import Prelude hiding (unwords)
import Protolude hiding (from, intercalate, ord, cast)
import PostgREST.ApiRequest (PreferRepresentation (..))
{-| The generic query result format used by API responses. The location header
@@ -183,8 +177,8 @@ addRelations schema allRelations parentNode node@(Node readNode@(query, (name, _
findRelationByTable s t1 t2 =
find (\r -> s == tableSchema (relTable r) && s == tableSchema (relFTable r) && t1 == tableName (relTable r) && t2 == tableName (relFTable r)) allRelations
findRelationByColumn s t c =
find (\r -> s == tableSchema (relTable r) && s == tableSchema (relFTable r) && t == tableName (relFTable r) && length (relFColumns r) == 1 && c `colMatches` (colName . head . relFColumns) r) allRelations
where n `colMatches` rc = (cs ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (cs n :: BS.ByteString)
find (\r -> s == tableSchema (relTable r) && s == tableSchema (relFTable r) && t == tableName (relFTable r) && length (relFColumns r) == 1 && c `colMatches` fromMaybe "" (colName <$> (head . relFColumns) r)) allRelations
where n `colMatches` rc = (toS ("^" <> rc <> "_?(?:|[iI][dD]|[fF][kK])$") :: BS.ByteString) =~ (toS n :: BS.ByteString)
addJoinConditions :: Schema -> ReadRequest -> Either Text ReadRequest
addJoinConditions schema (Node nn@(query, (n, r, a)) forest) =
@@ -212,8 +206,8 @@ callProc qi params selectQuery countQuery _ countTotal isSingle =
SELECT
{countResultF} AS total_result_set,
pg_catalog.count(t) AS page_total,
case
when pg_catalog.count(1) > 1 then
case
when pg_catalog.count(1) > 1 then
{bodyF}
else
coalesce(((array_agg(row_to_json(t)))[1]->{_procName})::character varying, {bodyF})
@@ -257,7 +251,7 @@ operators = [
]
pgFmtIdent :: SqlFragment -> SqlFragment
pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ cs x) <> "\""
pgFmtIdent x = "\"" <> replace "\"" "\"\"" (trimNullChars $ toS x) <> "\""
pgFmtLit :: SqlFragment -> SqlFragment
pgFmtLit x =
@@ -312,9 +306,9 @@ requestToQuery schema isParent (DbRead (Node (Select colSelects tbls conditions
clause = intercalate "," (map queryTerm ts)
queryTerm :: OrderTerm -> Text
queryTerm t = " "
<> cs (pgFmtColumn qi $ otTerm t) <> " "
<> (cs.show) (otDirection t) <> " "
<> maybe "" (cs.show) (otNullOrder t) <> " "
<> toS (pgFmtColumn qi $ otTerm t) <> " "
<> show (otDirection t) <> " "
<> maybe "" show (otNullOrder t) <> " "
(joins, selects) = foldr getQueryParts ([],[]) forest
getQueryParts :: Tree ReadNode -> ([SqlFragment], [SqlFragment]) -> ([SqlFragment], [SqlFragment])
@@ -386,9 +380,9 @@ sourceCTEName = "pg_source"
unquoted :: JSON.Value -> Text
unquoted (JSON.String t) = t
unquoted (JSON.Number n) =
cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
unquoted (JSON.Bool b) = cs . show $ b
unquoted v = cs $ JSON.encode v
toS $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n
unquoted (JSON.Bool b) = show b
unquoted v = toS $ JSON.encode v
-- private functions
asCsvF :: SqlFragment
@@ -428,8 +422,8 @@ limitF r = if r == allRange
then ""
else "LIMIT " <> limit <> " OFFSET " <> offset
where
limit = maybe "ALL" (cs . show) $ rangeLimit r
offset = cs . show $ rangeOffset r
limit = maybe "ALL" show $ rangeLimit r
offset = show $ rangeOffset r
fromQi :: QualifiedIdentifier -> SqlFragment
fromQi t = (if s == "" then "" else pgFmtIdent s <> ".") <> pgFmtIdent n
@@ -463,7 +457,7 @@ insertableValue v = (<> "::unknown") . pgFmtLit $ unquoted v
whiteList :: Text -> SqlFragment
whiteList val = fromMaybe
(cs (pgFmtLit val) <> "::unknown ")
(toS (pgFmtLit val) <> "::unknown ")
(find ((==) . toLower $ val) ["null","true","false"])
pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment
@@ -484,7 +478,7 @@ pgFmtCondition table (Filter (col,jp) ops val) =
where
headPredicate:rest = split (=='.') ops
hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
opCode = hasNot (head rest) headPredicate
opCode = hasNot (headDef "eq" rest) headPredicate
notOp = hasNot headPredicate ""
sqlCol = case val of
VText _ -> pgFmtColumn table col <> pgFmtJsonPath jp
@@ -524,7 +518,9 @@ pgFmtJsonPath _ = ""
pgFmtAs :: Maybe JsonPath -> Maybe Alias -> SqlFragment
pgFmtAs Nothing Nothing = ""
pgFmtAs (Just xx) Nothing = " AS " <> pgFmtIdent (last xx)
pgFmtAs (Just xx) Nothing = case lastMay xx of
Just alias -> " AS " <> pgFmtIdent alias
Nothing -> ""
pgFmtAs _ (Just alias) = " AS " <> pgFmtIdent alias
trimNullChars :: Text -> Text