Fix hlint

This commit is contained in:
Joe Nelson
2014-09-10 21:32:30 -07:00
parent d3ae4aca2b
commit 016490bea7
+8 -10
View File
@@ -14,7 +14,7 @@ import Options.Applicative hiding (columns)
import Data.Maybe (fromMaybe, isJust) import Data.Maybe (fromMaybe, isJust)
import Text.Read (readMaybe) import Text.Read (readMaybe)
import Text.Regex.TDFA ((=~)) import Text.Regex.TDFA ((=~))
import Data.Map (intersection, fromList, toList) import Data.Map (intersection, fromList, toList, Map)
import Data.List (sort) import Data.List (sort)
import qualified Data.Set as S import qualified Data.Set as S
import Data.Convertible.Base (convert) import Data.Convertible.Base (convert)
@@ -33,7 +33,6 @@ import qualified Data.ByteString.Char8 as BS
import Database.HDBC.PostgreSQL (Connection) import Database.HDBC.PostgreSQL (Connection)
import Database.HDBC.Types (SqlError, seErrorMsg) import Database.HDBC.Types (SqlError, seErrorMsg)
import Database.HDBC.SqlValue (SqlValue(..))
import PgStructure (printTables, printColumns, primaryKeyColumns, import PgStructure (printTables, printColumns, primaryKeyColumns,
columns, Column(colName)) columns, Column(colName))
@@ -65,6 +64,11 @@ jsonBodyAction req handler = do
jsonBody :: Request -> IO (Either String SqlRow) jsonBody :: Request -> IO (Either String SqlRow)
jsonBody = fmap JSON.eitherDecode . strictRequestBody jsonBody = fmap JSON.eitherDecode . strictRequestBody
filterByKeys :: Ord a => Map a b -> [a] -> Map a b
filterByKeys m keys =
if null keys then m else
m `intersection` fromList (zip keys $ repeat undefined)
app :: Connection -> Application app :: Connection -> Application
app conn req respond = do app conn req respond = do
r <- try $ r <- try $
@@ -94,10 +98,7 @@ app conn req respond = do
jsonBodyAction req (\row -> do jsonBodyAction req (\row -> do
allvals <- insert ver table row conn allvals <- insert ver table row conn
keys <- primaryKeyColumns ver (unpack table) conn keys <- primaryKeyColumns ver (unpack table) conn
let keyvals = if null keys let params = urlEncodeVars $ map (\t -> (fst t, "eq." <> convert (snd t) :: String)) $ toList $ filterByKeys allvals keys
then allvals
else allvals `intersection` fromList (zip keys $ repeat SqlNull)
let params = urlEncodeVars $ map (\t -> (fst t, "eq." <> convert (snd t) :: String)) $ toList keyvals
return $ responseLBS status201 return $ responseLBS status201
[ jsonContentType [ jsonContentType
, (hLocation, "/" <> encodeUtf8 table <> "?" <> BS.pack params) , (hLocation, "/" <> encodeUtf8 table <> "?" <> BS.pack params)
@@ -121,10 +122,7 @@ app conn req respond = do
let specifiedCols = S.fromList $ map fst $ getRow row let specifiedCols = S.fromList $ map fst $ getRow row
if colNames == specifiedCols then do if colNames == specifiedCols then do
allvals <- upsert ver table row qq conn allvals <- upsert ver table row qq conn
let keyvals = if null keys let params = urlEncodeVars $ map (\t -> (fst t, "eq." <> convert (snd t) :: String)) $ toList $ filterByKeys allvals keys
then allvals
else allvals `intersection` fromList (zip keys $ repeat SqlNull)
let params = urlEncodeVars $ map (\t -> (fst t, "eq." <> convert (snd t) :: String)) $ toList keyvals
return $ responseLBS status201 return $ responseLBS status201
[ jsonContentType [ jsonContentType
, (hLocation, "/" <> encodeUtf8 table <> "?" <> BS.pack params) , (hLocation, "/" <> encodeUtf8 table <> "?" <> BS.pack params)