diff --git a/src/PostgREST/Functions.hs b/src/PostgREST/Functions.hs index 15e4dabcf..afa915950 100644 --- a/src/PostgREST/Functions.hs +++ b/src/PostgREST/Functions.hs @@ -8,6 +8,7 @@ import Data.List (find) import Data.Monoid import Data.Text hiding (filter, find, foldr, head, last, map, null) + import Data.Tree import PostgREST.PgQuery (PStmt, QualifiedIdentifier (..), fromQi, orderT, pgFmtIdent, pgFmtLit, pgFmtOperator, @@ -35,17 +36,16 @@ findRelation allRelations s t1 t2 = filterToCondition :: Text -> [Column] -> Text -> Filter -> Either Text Condition filterToCondition schema allColumns table (Filter fld op val) = - Condition <$> c <*> pure op <*> pure (VText (pack val)) + Condition <$> c <*> pure op <*> pure (VText val) where c = (,) <$> column <*> pure (snd fld) - column = findColumn allColumns schema table $ pack $ fst fld + column = findColumn allColumns schema table $ fst fld requestNodeToQuery ::Text -> [Table] -> [Column] -> RequestNode -> Either Text Query -requestNodeToQuery schema allTables allColumns (RequestNode tblNameS flds fltrs ord) = +requestNodeToQuery schema allTables allColumns (RequestNode tblName flds fltrs ord) = Select <$> mainTable <*> select <*> joinTables <*> qwhere <*> rel <*> pure ord where - tblName = pack tblNameS mainTable = findTable allTables schema tblName select = mapM toDbSelectItem flds --besides specific columns, we allow * here also where @@ -54,7 +54,7 @@ requestNodeToQuery schema allTables allColumns (RequestNode tblNameS flds fltrs toDbSelectItem (("*", Nothing), Nothing) = Right ((Star{colSchema = schema, colTable = tblName}, Nothing), Nothing) toDbSelectItem ((c,jp), cast) = (,) <$> dbFld <*> pure cast where - col = findColumn allColumns schema tblName $ pack c + col = findColumn allColumns schema tblName c dbFld = (,) <$> col <*> pure jp qwhere = mapM (filterToCondition schema allColumns tblName) fltrs @@ -166,7 +166,7 @@ pgFmtCondition (Condition (col,jp) ops val) = notOp <> " " <> pgFmtColumn col <> pgFmtJsonPath jp <> " " <> pgFmtOperator opCode <> " " <> if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue where - headPredicate:rest = split (=='.') $ pack ops + headPredicate:rest = split (=='.') ops hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse opCode = hasNot (head rest) headPredicate notOp = hasNot headPredicate "" @@ -183,8 +183,8 @@ pgFmtColumn Column {colSchema=s, colTable=t, colName=c} = pgFmtIdent s <> "." <> pgFmtColumn Star {colSchema=s, colTable=t} = pgFmtIdent s <> "." <> pgFmtIdent t <> ".*" pgFmtJsonPath :: Maybe JsonPath -> Text -pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit (pack x) -pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit (pack x) <> pgFmtJsonPath ( Just xs ) +pgFmtJsonPath (Just [x]) = "->>" <> pgFmtLit x +pgFmtJsonPath (Just (x:xs)) = "->" <> pgFmtLit x <> pgFmtJsonPath ( Just xs ) pgFmtJsonPath _ = "" pgFmtTable :: Table -> Text @@ -192,8 +192,8 @@ pgFmtTable Table{tableSchema=s, tableName=n} = fromQi $ QualifiedIdentifier s n selectItemToStr :: DbSelectItem -> Text selectItemToStr ((c, jp), Nothing) = pgFmtColumn c <> pgFmtJsonPath jp <> asJsonPath jp -selectItemToStr ((c, jp), Just cast ) = "CAST (" <> pgFmtColumn c <> pgFmtJsonPath jp <> " AS " <> pack cast <> " )" <> asJsonPath jp +selectItemToStr ((c, jp), Just cast ) = "CAST (" <> pgFmtColumn c <> pgFmtJsonPath jp <> " AS " <> cast <> " )" <> asJsonPath jp asJsonPath :: Maybe JsonPath -> Text asJsonPath Nothing = "" -asJsonPath (Just xx) = " AS " <> pack (last xx) +asJsonPath (Just xx) = " AS " <> last xx diff --git a/src/PostgREST/Parsers.hs b/src/PostgREST/Parsers.hs index e26321e1a..6ad2e59e5 100644 --- a/src/PostgREST/Parsers.hs +++ b/src/PostgREST/Parsers.hs @@ -8,7 +8,9 @@ import Control.Applicative import Control.Monad (join) import Data.List (delete, find) import Data.Maybe +import Data.Monoid import Data.String.Conversions (cs) +import Data.Text (Text) import Data.Tree import Network.Wai (Request, pathInfo, queryString) import PostgREST.Types @@ -27,7 +29,7 @@ parseGetRequest httpRequest = selectStr = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qString --in case the parametre is missing or empty we default to * whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select", "order"], isJust v ] -pRequestSelect :: String -> Parser ApiRequest +pRequestSelect :: Text -> Parser ApiRequest pRequestSelect rootNodeName = do fieldTree <- pFieldForest return $ foldr treeEntry (Node (RequestNode rootNodeName [] [] Nothing) []) fieldTree @@ -41,8 +43,8 @@ pRequestSelect rootNodeName = do pRequestFilter :: (String, String) -> Either ParseError (Path, Filter) pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val) where - treePath = parse pTreePath ("failed to parser tree path ("++k++")") k - opVal = parse pOpValueExp ("failed to parse filter ("++v++")") v + treePath = parse pTreePath ("failed to parser tree path (" ++ k ++ ")") k + opVal = parse pOpValueExp ("failed to parse filter (" ++ v ++ ")") v path = fst <$> treePath fld = snd <$> treePath op = fst <$> opVal @@ -63,8 +65,8 @@ addFilter (path, flt) (Node rn forest) = Just node -> (Just node, delete node forest) where maybeNode = find ((name==).nodeName.rootLabel) forst -ws :: Parser String -ws = many (oneOf " \t") +ws :: Parser Text +ws = cs <$> many (oneOf " \t") lexeme :: Parser a -> Parser a lexeme p = ws *> p <* ws @@ -73,7 +75,10 @@ pTreePath :: Parser (Path,Field) pTreePath = do p <- pFieldName `sepBy1` pDelimiter jp <- optionMaybe ( string "->" >> pJsonPath) - return (init p, (last p, jp)) + let pp = map cs p + jpp = map cs <$> jp + return (init pp, (last pp, jpp)) + where pFieldForest :: Parser [Tree SelectItem] @@ -83,17 +88,17 @@ pFieldTree :: Parser (Tree SelectItem) pFieldTree = try (Node <$> pSelect <*> ( char '(' *> pFieldForest <* char ')')) <|> Node <$> pSelect <*> pure [] -pStar :: Parser String -pStar = string "*" *> pure "*" +pStar :: Parser Text +pStar = cs <$> (string "*" *> pure ("*"::String)) -pFieldName :: Parser String -pFieldName = many1 (letter <|> digit <|> oneOf "_") - "field name (* or [a..z0..9_])" +pFieldName :: Parser Text +pFieldName = cs <$> (many1 (letter <|> digit <|> oneOf "_") + "field name (* or [a..z0..9_])") -pJsonPathDelimiter :: Parser String -pJsonPathDelimiter = try (string "->>") <|> string "->" +pJsonPathDelimiter :: Parser Text +pJsonPathDelimiter = cs <$> (try (string "->>") <|> string "->") -pJsonPath :: Parser [String] +pJsonPath :: Parser [Text] pJsonPath = pFieldName `sepBy1` pJsonPathDelimiter pField :: Parser Field @@ -101,13 +106,13 @@ pField = lexeme $ (,) <$> pFieldName <*> optionMaybe ( pJsonPathDelimiter *> pJ pSelect :: Parser SelectItem pSelect = lexeme $ - try ((,) <$> pField <*> optionMaybe (string "::" *> many letter)) + try ((,) <$> pField <*>((cs <$>) <$> optionMaybe (string "::" *> many letter)) ) <|> do s <- pStar return ((s, Nothing), Nothing) pOperator :: Parser Operator -pOperator = try (string "lte") -- has to be before lt +pOperator = cs <$> ( try (string "lte") -- has to be before lt <|> try (string "lt") <|> try (string "eq") <|> try (string "gte") -- has to be before gh @@ -122,6 +127,7 @@ pOperator = try (string "lte") -- has to be before lt <|> try (string "isnot") <|> try (string "@@") "operator (eq, gt, ...)" + ) -- pInt :: Parser Int -- pInt = try (liftA read (many1 digit)) "integer" @@ -130,13 +136,13 @@ pOperator = try (string "lte") -- has to be before lt --pValue = (VInt <$> try (pInt <* eof)) -- <|>(VString <$> many anyChar) pValue :: Parser FValue -pValue = many anyChar +pValue = cs <$> many anyChar pDelimiter :: Parser Char pDelimiter = char '.' "delimiter (.)" pOperatiorWithNegation :: Parser Operator -pOperatiorWithNegation = try ( (++) <$> string "not." <*> pOperator) <|> pOperator +pOperatiorWithNegation = try ( (<>) <$> ( cs <$> string "not." ) <*> pOperator) <|> pOperator pOpValueExp :: Parser (Operator, FValue) pOpValueExp = (,) <$> pOperatiorWithNegation <*> (pDelimiter *> pValue) diff --git a/src/PostgREST/Types.hs b/src/PostgREST/Types.hs index 3321b0e68..901766a58 100644 --- a/src/PostgREST/Types.hs +++ b/src/PostgREST/Types.hs @@ -63,17 +63,17 @@ data Relation = Relation { -------- -- Request Types -type Operator = String -type FValue = String +type Operator = Text +type FValue = Text type ApiRequest = Tree RequestNode -type FieldName = String -type JsonPath = [String] +type FieldName = Text +type JsonPath = [Text] type Field = (FieldName, Maybe JsonPath) -type Cast = String +type Cast = Text type SelectItem = (Field, Maybe Cast) -type Path = [String] +type Path = [Text] data RequestNode = RequestNode { - nodeName::String + nodeName::Text , fields::[SelectItem] , filters::[Filter] , order::Maybe [OrderTerm]