small refactor

This commit is contained in:
Ruslan Talpa
2015-11-20 18:19:13 +02:00
parent cf2e45d47f
commit 78fd766de3
+12 -15
View File
@@ -117,10 +117,11 @@ app dbStructure conf reqBody req =
) )
] (fromMaybe "[]" body) ] (fromMaybe "[]" body)
(ActionCreate, TargetIdent (QualifiedIdentifier _ table), Just (PayloadJSON _)) -> (ActionCreate, TargetIdent (QualifiedIdentifier _ table), Just (PayloadJSON payload)) ->
case queries of case queries of
Left e -> return $ responseLBS status400 [jsonH] $ cs e Left e -> return $ responseLBS status400 [jsonH] $ cs e
Right (sq,mq,isSingle) -> do Right (sq,mq) -> do
let isSingle = (==1) $ V.length payload
let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself? let pKeys = map pkName $ filter (filterPk schema table) allPrKeys -- would it be ok to move primary key detection in the query itself?
let stm = createWriteStatement sq mq isSingle (iPreferRepresentation intent) pKeys (contentType == TextCSV) let stm = createWriteStatement sq mq isSingle (iPreferRepresentation intent) pKeys (contentType == TextCSV)
row <- H.maybeEx stm row <- H.maybeEx stm
@@ -135,7 +136,7 @@ app dbStructure conf reqBody req =
(ActionUpdate, TargetIdent _, Just (PayloadJSON _)) -> (ActionUpdate, TargetIdent _, Just (PayloadJSON _)) ->
case queries of case queries of
Left e -> return $ responseLBS status400 [jsonH] $ cs e Left e -> return $ responseLBS status400 [jsonH] $ cs e
Right (sq,mq,_) -> do Right (sq,mq) -> do
let stm = createWriteStatement sq mq False (iPreferRepresentation intent) [] (contentType == TextCSV) let stm = createWriteStatement sq mq False (iPreferRepresentation intent) [] (contentType == TextCSV)
row <- H.maybeEx stm row <- H.maybeEx stm
let (_, queryTotal, _, body) = extractQueryResult row let (_, queryTotal, _, body) = extractQueryResult row
@@ -149,7 +150,7 @@ app dbStructure conf reqBody req =
(ActionDelete, TargetIdent _, Nothing) -> (ActionDelete, TargetIdent _, Nothing) ->
case queries of case queries of
Left e -> return $ responseLBS status400 [jsonH] $ cs e Left e -> return $ responseLBS status400 [jsonH] $ cs e
Right (sq,mq,_) -> do Right (sq,mq) -> do
let stm = createWriteStatement sq mq False False [] (contentType == TextCSV) let stm = createWriteStatement sq mq False False [] (contentType == TextCSV)
row <- H.maybeEx stm row <- H.maybeEx stm
let (_, queryTotal, _, _) = extractQueryResult row let (_, queryTotal, _, _) = extractQueryResult row
@@ -208,13 +209,9 @@ app dbStructure conf reqBody req =
allOrigins = ("Access-Control-Allow-Origin", "*") :: Header allOrigins = ("Access-Control-Allow-Origin", "*") :: Header
schema = cs $ configSchema conf schema = cs $ configSchema conf
intent = userIntent schema req reqBody intent = userIntent schema req reqBody
selectApiRequest = buildSelectApiRequest intent (dbRelations dbStructure) selectQuery = requestToQuery schema <$> buildSelectApiRequest (dbRelations dbStructure) intent
selectQuery = requestToQuery schema <$> selectApiRequest mutateQuery = requestToQuery schema <$> buildMutateApiRequest intent
mutateTuple = buildMutateApiRequest intent queries = (,) <$> selectQuery <*> mutateQuery
mutateApiRequest = fst <$> mutateTuple
isSingleRecord = snd <$> mutateTuple
mutateQuery = requestToQuery schema <$> mutateApiRequest
queries = (,,) <$> selectQuery <*> mutateQuery <*> isSingleRecord
rangeStatus :: Int -> Int -> Maybe Int -> Status rangeStatus :: Int -> Int -> Maybe Int -> Status
rangeStatus _ _ Nothing = status200 rangeStatus _ _ Nothing = status200
@@ -297,8 +294,8 @@ augumentRequestWithJoin schema allRels request =
(first formatRelationError . addRelations schema allRels Nothing) request (first formatRelationError . addRelations schema allRels Nothing) request
>>= addJoinConditions schema >>= addJoinConditions schema
buildSelectApiRequest :: Intent -> [Relation] -> Either Text ApiRequest buildSelectApiRequest :: [Relation] -> Intent -> Either Text ApiRequest
buildSelectApiRequest intent allRels = buildSelectApiRequest allRels intent =
augumentRequestWithJoin schema rels =<< first formatParserError (foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts) augumentRequestWithJoin schema rels =<< first formatParserError (foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts)
where where
selStr = iSelect intent selStr = iSelect intent
@@ -326,9 +323,9 @@ buildSelectApiRequest intent allRels =
flts = mapM pRequestFilter filters flts = mapM pRequestFilter filters
ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderS++">>")) orderS ord = traverse (parse pOrder ("failed to parse order parameter <<"++fromMaybe "" orderS++">>")) orderS
buildMutateApiRequest :: Intent -> Either Text (ApiRequest, Bool) buildMutateApiRequest :: Intent -> Either Text ApiRequest
buildMutateApiRequest intent = buildMutateApiRequest intent =
(,) <$> mutateApiRequest <*> pure isSingleRecord mutateApiRequest
where where
action = iAction intent action = iAction intent
target = iTarget intent target = iTarget intent