hlint pass
This commit is contained in:
Jake Wheat
parent
858c7723b0
commit
fe6b71fa2a
|
|
@ -71,7 +71,6 @@ try again to add annotation to the ast
|
|||
-}
|
||||
|
||||
-- | Lexer for SQL.
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
|
|
@ -150,6 +149,7 @@ import Data.Char
|
|||
import Control.Monad (void, guard)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Maybe (fromMaybe)
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
|
|
@ -223,13 +223,13 @@ lexSQL
|
|||
-- ^ the SQL source to lex
|
||||
-> Either ParseError [Token]
|
||||
lexSQL dialect fn p src =
|
||||
fmap (map tokenVal) $ lexSQLWithPositions dialect fn p src
|
||||
map tokenVal <$> lexSQLWithPositions dialect fn p src
|
||||
|
||||
myParse :: Text -> (Maybe (Int,Int)) -> Parser a -> Text -> Either ParseError a
|
||||
myParse :: Text -> Maybe (Int,Int) -> Parser a -> Text -> Either ParseError a
|
||||
myParse name sp' p s =
|
||||
let sp = maybe (1,1) id sp'
|
||||
let sp = fromMaybe (1,1) sp'
|
||||
ps = SourcePos (T.unpack name) (mkPos $ fst sp) (mkPos $ snd sp)
|
||||
is = (initialState (T.unpack name) s)
|
||||
is = initialState (T.unpack name) s
|
||||
sps = (statePosState is) {pstateSourcePos = ps}
|
||||
is' = is {statePosState = sps}
|
||||
in snd $ runParser' p is'
|
||||
|
|
@ -352,7 +352,7 @@ sqlString d = dollarString <|> csString <|> normalString
|
|||
<$> try cs
|
||||
<*> pure "'"
|
||||
<*> normalStringSuffix False ""
|
||||
csPrefixes = (map (flip T.cons "'") "nNbBxX") ++ ["u&'", "U&'"]
|
||||
csPrefixes = map (`T.cons` "'") "nNbBxX" ++ ["u&'", "U&'"]
|
||||
cs :: Parser Text
|
||||
cs = choice $ map string csPrefixes
|
||||
|
||||
|
|
@ -387,7 +387,7 @@ identifier d =
|
|||
-- try is used here to avoid a conflict with identifiers
|
||||
-- and quoted strings which also start with a 'u'
|
||||
unicodeQuotedIden = Identifier
|
||||
<$> (f <$> try ((oneOf "uU") <* string "&"))
|
||||
<$> (f <$> try (oneOf "uU" <* string "&"))
|
||||
<*> qidenPart
|
||||
where f x = Just (T.cons x "&\"", "\"")
|
||||
qidenPart = char '"' *> qidenSuffix ""
|
||||
|
|
@ -404,7 +404,7 @@ identifierString :: Parser Text
|
|||
identifierString = (do
|
||||
c <- satisfy isFirstLetter
|
||||
choice
|
||||
[T.cons c <$> (takeWhileP (Just "identifier char") isIdentifierChar)
|
||||
[T.cons c <$> takeWhileP (Just "identifier char") isIdentifierChar
|
||||
,pure $ T.singleton c]) <?> "identifier"
|
||||
where
|
||||
isFirstLetter c = c == '_' || isAlpha c
|
||||
|
|
@ -486,7 +486,7 @@ sqlNumber d =
|
|||
-- this is for definitely avoiding possibly ambiguous source
|
||||
<* choice [-- special case to allow e.g. 1..2
|
||||
guard (diPostgresSymbols d)
|
||||
*> (void $ lookAhead $ try $ (string ".." <?> ""))
|
||||
*> void (lookAhead $ try (string ".." <?> ""))
|
||||
<|> void (notFollowedBy (oneOf "eE."))
|
||||
,notFollowedBy (oneOf "eE.")
|
||||
]
|
||||
|
|
@ -737,7 +737,7 @@ two symbols next to eachother will fail if the symbols can combine and
|
|||
| diPostgresSymbols d
|
||||
, Symbol a' <- a
|
||||
, Symbol b' <- b
|
||||
, b' `notElem` ["+", "-"] || or (map (`T.elem` a') "~!@#%^&|`?") = False
|
||||
, b' `notElem` ["+", "-"] || any (`T.elem` a') ("~!@#%^&|`?" :: [Char]) = False
|
||||
|
||||
{-
|
||||
check two adjacent symbols in non postgres where the combination
|
||||
|
|
|
|||
|
|
@ -217,6 +217,7 @@ import Control.Monad.Reader
|
|||
(Reader
|
||||
,runReader
|
||||
,ask
|
||||
,asks
|
||||
)
|
||||
|
||||
import qualified Data.Set as Set
|
||||
|
|
@ -227,7 +228,7 @@ import Control.Applicative ((<**>))
|
|||
import Data.Char (isDigit)
|
||||
import Data.List (sort,groupBy)
|
||||
import Data.Function (on)
|
||||
import Data.Maybe (catMaybes, isJust)
|
||||
import Data.Maybe (catMaybes, isJust, mapMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
||||
|
|
@ -379,7 +380,7 @@ u&"example quoted"
|
|||
|
||||
name :: Parser Name
|
||||
name = do
|
||||
bl <- queryDialect diKeywords
|
||||
bl <- askDialect diKeywords
|
||||
uncurry Name <$> identifierTok bl
|
||||
|
||||
-- todo: replace (:[]) with a named function all over
|
||||
|
|
@ -561,7 +562,7 @@ typeName =
|
|||
-- type names, plus all the type names which are
|
||||
-- reserved words
|
||||
reservedTypeNames = do
|
||||
stn <- queryDialect diSpecialTypeNames
|
||||
stn <- askDialect diSpecialTypeNames
|
||||
(:[]) . Name Nothing . T.unwords <$> makeKeywordTree stn
|
||||
|
||||
|
||||
|
|
@ -771,7 +772,7 @@ idenExpr =
|
|||
-- special cases for keywords that can be parsed as an iden or app
|
||||
keywordFunctionOrIden = try $ do
|
||||
x <- unquotedIdentifierTok [] Nothing
|
||||
d <- queryDialect id
|
||||
d <- askDialect id
|
||||
let i = T.toLower x `elem` diIdentifierKeywords d
|
||||
a = T.toLower x `elem` diAppKeywords d
|
||||
case () of
|
||||
|
|
@ -923,7 +924,7 @@ app =
|
|||
openParen *> choice
|
||||
[duplicates
|
||||
<**> (commaSep1 scalarExpr
|
||||
<**> (((option [] orderBy) <* closeParen)
|
||||
<**> ((option [] orderBy <* closeParen)
|
||||
<**> (optional afilter <$$$$$> AggregateApp)))
|
||||
-- separate cases with no all or distinct which must have at
|
||||
-- least one scalar expr
|
||||
|
|
@ -967,17 +968,17 @@ window :: Parser ([ScalarExpr] -> [Name] -> ScalarExpr)
|
|||
window =
|
||||
keyword_ "over" *> openParen *> option [] partitionBy
|
||||
<**> (option [] orderBy
|
||||
<**> (((optional frameClause) <* closeParen) <$$$$$> WindowApp))
|
||||
<**> ((optional frameClause <* closeParen) <$$$$$> WindowApp))
|
||||
where
|
||||
partitionBy = keywords_ ["partition","by"] *> commaSep1 scalarExpr
|
||||
frameClause =
|
||||
frameRowsRange -- TODO: this 'and' could be an issue
|
||||
<**> (choice [(keyword_ "between" *> frameLimit True)
|
||||
<**> choice [(keyword_ "between" *> frameLimit True)
|
||||
<**> ((keyword_ "and" *> frameLimit True)
|
||||
<$$$> FrameBetween)
|
||||
-- maybe this should still use a b expression
|
||||
-- for consistency
|
||||
,frameLimit False <**> pure (flip FrameFrom)])
|
||||
,frameLimit False <**> pure (flip FrameFrom)]
|
||||
frameRowsRange = FrameRows <$ keyword_ "rows"
|
||||
<|> FrameRange <$ keyword_ "range"
|
||||
frameLimit useB =
|
||||
|
|
@ -1013,7 +1014,7 @@ inSuffix =
|
|||
where
|
||||
inty = choice [True <$ keyword_ "in"
|
||||
,False <$ keywords_ ["not","in"]]
|
||||
mkIn i v = \e -> In i e v
|
||||
mkIn i v e = In i e v
|
||||
|
||||
{-
|
||||
=== between
|
||||
|
|
@ -1034,14 +1035,15 @@ and operator. This is the call to scalarExprB.
|
|||
|
||||
betweenSuffix :: Parser (ScalarExpr -> ScalarExpr)
|
||||
betweenSuffix =
|
||||
makeOp <$> Name Nothing <$> opName
|
||||
makeOp . Name Nothing
|
||||
<$> opName
|
||||
<*> scalarExprB
|
||||
<*> (keyword_ "and" *> scalarExprB)
|
||||
where
|
||||
opName = choice
|
||||
["between" <$ keyword_ "between"
|
||||
,"not between" <$ try (keywords_ ["not","between"])]
|
||||
makeOp n b c = \a -> SpecialOp [n] [a,b,c]
|
||||
makeOp n b c a = SpecialOp [n] [a,b,c]
|
||||
|
||||
{-
|
||||
=== quantified comparison
|
||||
|
|
@ -1224,7 +1226,7 @@ opTable bExpr =
|
|||
|
||||
,[prefixKeyword "not"]
|
||||
|
||||
,if bExpr then [] else [binaryKeywordL "and"]
|
||||
,[binaryKeywordL "and" | not bExpr]
|
||||
|
||||
,[binaryKeywordL "or"]
|
||||
|
||||
|
|
@ -1368,7 +1370,7 @@ from = keyword_ "from" *> commaSep1 tref
|
|||
where
|
||||
-- TODO: use P (a->) for the join tref suffix
|
||||
-- chainl or buildexpressionparser
|
||||
tref = (nonJoinTref <?> "table ref") >>= optionSuffix (joinTrefSuffix)
|
||||
tref = (nonJoinTref <?> "table ref") >>= optionSuffix joinTrefSuffix
|
||||
nonJoinTref = choice
|
||||
[parens $ choice
|
||||
[TRQueryExpr <$> queryExpr
|
||||
|
|
@ -1519,7 +1521,7 @@ queryExpr = E.makeExprParser qeterm qeOpTable
|
|||
mkSelect
|
||||
<$> option SQDefault duplicates
|
||||
<*> selectList
|
||||
<*> (optional tableExpression) <?> "table expression"
|
||||
<*> optional tableExpression <?> "table expression"
|
||||
mkSelect d sl Nothing =
|
||||
toQueryExpr $ makeSelect {msSetQuantifier = d, msSelectList = sl}
|
||||
mkSelect d sl (Just (TableExpression f w g h od ofs fe)) =
|
||||
|
|
@ -1621,7 +1623,7 @@ statementWithoutSemicolon = choice
|
|||
]
|
||||
|
||||
statement :: Parser Statement
|
||||
statement = statementWithoutSemicolon <* optional semi <|> semi *> pure EmptyStatement
|
||||
statement = statementWithoutSemicolon <* optional semi <|> EmptyStatement <$ semi
|
||||
|
||||
createSchema :: Parser Statement
|
||||
createSchema = keyword_ "schema" >>
|
||||
|
|
@ -1629,7 +1631,7 @@ createSchema = keyword_ "schema" >>
|
|||
|
||||
createTable :: Parser Statement
|
||||
createTable = do
|
||||
d <- queryDialect id
|
||||
d <- askDialect id
|
||||
let
|
||||
parseColumnDef = TableColumnDef <$> columnDef
|
||||
parseConstraintDef = uncurry TableConstraintDef <$> tableConstraintDef
|
||||
|
|
@ -1675,7 +1677,7 @@ columnDef = ColumnDef <$> name <*> typeName
|
|||
tableConstraintDef :: Parser (Maybe [Name], TableConstraint)
|
||||
tableConstraintDef =
|
||||
(,)
|
||||
<$> (optional (keyword_ "constraint" *> names))
|
||||
<$> optional (keyword_ "constraint" *> names)
|
||||
<*> (unique <|> primaryKey <|> check <|> references)
|
||||
where
|
||||
unique = keyword_ "unique" >>
|
||||
|
|
@ -1725,7 +1727,7 @@ colConstraintDef =
|
|||
unique = ColUniqueConstraint <$ keyword_ "unique"
|
||||
primaryKey = do
|
||||
keywords_ ["primary", "key"]
|
||||
d <- queryDialect id
|
||||
d <- askDialect id
|
||||
autoincrement <- if diAutoincrement d
|
||||
then optional (keyword_ "autoincrement")
|
||||
else pure Nothing
|
||||
|
|
@ -2099,9 +2101,9 @@ makeKeywordTree sets =
|
|||
parseGroup :: [[Text]] -> Parser [Text]
|
||||
parseGroup l@((k:_):_) = do
|
||||
keyword_ k
|
||||
let tls = catMaybes $ map safeTail l
|
||||
let tls = mapMaybe safeTail l
|
||||
pr = (k:) <$> parseTrees tls
|
||||
if (or $ map null tls)
|
||||
if any null tls
|
||||
then pr <|> pure [k]
|
||||
else pr
|
||||
parseGroup _ = guard False >> fail "impossible"
|
||||
|
|
@ -2175,7 +2177,7 @@ unsignedInteger = read . T.unpack <$> sqlNumberTok True <?> "natural number"
|
|||
-- todo: work out the symbol parsing better
|
||||
|
||||
symbol :: Text -> Parser Text
|
||||
symbol s = symbolTok (Just s) <?> (T.unpack s)
|
||||
symbol s = symbolTok (Just s) <?> T.unpack s
|
||||
|
||||
singleCharSymbol :: Char -> Parser Char
|
||||
singleCharSymbol c = c <$ symbol (T.singleton c)
|
||||
|
|
@ -2205,12 +2207,12 @@ semi = singleCharSymbol ';' <?> ""
|
|||
-- = helper functions
|
||||
|
||||
keyword :: Text -> Parser Text
|
||||
keyword k = unquotedIdentifierTok [] (Just k) <?> (T.unpack k)
|
||||
keyword k = unquotedIdentifierTok [] (Just k) <?> T.unpack k
|
||||
|
||||
-- helper function to improve error messages
|
||||
|
||||
keywords_ :: [Text] -> Parser ()
|
||||
keywords_ ks = mapM_ keyword_ ks <?> (T.unpack (T.unwords ks))
|
||||
keywords_ ks = mapM_ keyword_ ks <?> T.unpack (T.unwords ks)
|
||||
|
||||
|
||||
parens :: Parser a -> Parser a
|
||||
|
|
@ -2270,7 +2272,7 @@ stringTokExtend = do
|
|||
guard (s == "'" && e == "'")
|
||||
(s',e',y) <- stringTokExtend
|
||||
guard (s' == "'" && e' == "'")
|
||||
pure $ (s,e,x <> y)
|
||||
pure (s,e,x <> y)
|
||||
,pure (s,e,x)
|
||||
]
|
||||
|
||||
|
|
@ -2361,12 +2363,8 @@ unquotedIdentifierTok blackList kw = token test Set.empty <?> ""
|
|||
-- dialect
|
||||
|
||||
guardDialect :: (Dialect -> Bool) -> Parser ()
|
||||
guardDialect p = do
|
||||
d <- ask
|
||||
guard (p d)
|
||||
guardDialect p = guard . p =<< ask
|
||||
|
||||
queryDialect :: (Dialect -> a) -> Parser a
|
||||
queryDialect f = do
|
||||
d <- ask
|
||||
pure $ f d
|
||||
askDialect :: (Dialect -> a) -> Parser a
|
||||
askDialect = asks
|
||||
|
||||
|
|
|
|||
|
|
@ -3,6 +3,7 @@
|
|||
-- source from ASTs. The code attempts to format the output in a
|
||||
-- readable way.
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
module Language.SQL.SimpleSQL.Pretty
|
||||
(prettyQueryExpr
|
||||
,prettyScalarExpr
|
||||
|
|
@ -120,7 +121,7 @@ scalarExpr d (WindowApp f es pb od fr) =
|
|||
<+> pretty "over"
|
||||
<+> parens ((case pb of
|
||||
[] -> mempty
|
||||
_ -> (pretty "partition by") <+> align
|
||||
_ -> pretty "partition by" <+> align
|
||||
(commaSep $ map (scalarExpr d) pb))
|
||||
<+> orderBy d od
|
||||
<+> me frd fr)
|
||||
|
|
@ -142,7 +143,7 @@ scalarExpr dia (SpecialOp nm [a,b,c])
|
|||
| nm `elem` [[Name Nothing "between"]
|
||||
,[Name Nothing "not between"]] =
|
||||
sep [scalarExpr dia a
|
||||
,names nm <+> nest ((T.length (unnames nm) - 3)) (sep
|
||||
,names nm <+> nest (T.length (unnames nm) - 3) (sep
|
||||
[scalarExpr dia b
|
||||
,pretty "and" <+> scalarExpr dia c])]
|
||||
|
||||
|
|
@ -206,10 +207,10 @@ scalarExpr d (SubQueryExpr ty qe) =
|
|||
scalarExpr d (QuantifiedComparison v c cp sq) =
|
||||
scalarExpr d v
|
||||
<+> names c
|
||||
<+> (pretty $ case cp of
|
||||
CPAny -> "any"
|
||||
CPSome -> "some"
|
||||
CPAll -> "all")
|
||||
<+> pretty (case cp of
|
||||
CPAny -> "any"
|
||||
CPSome -> "some"
|
||||
CPAll -> "all")
|
||||
<+> parens (queryExpr d sq)
|
||||
|
||||
scalarExpr d (Match v u sq) =
|
||||
|
|
@ -306,13 +307,13 @@ typeName (PrecScaleTypeName t a b) =
|
|||
typeName (PrecLengthTypeName t i m u) =
|
||||
names t
|
||||
<> parens (pretty (show i)
|
||||
<> me (\x -> case x of
|
||||
<> me (\case
|
||||
PrecK -> pretty "K"
|
||||
PrecM -> pretty "M"
|
||||
PrecG -> pretty "G"
|
||||
PrecT -> pretty "T"
|
||||
PrecP -> pretty "P") m
|
||||
<+> me (\x -> case x of
|
||||
<+> me (\case
|
||||
PrecCharacters -> pretty "CHARACTERS"
|
||||
PrecOctets -> pretty "OCTETS") u)
|
||||
typeName (CharTypeName t i cs col) =
|
||||
|
|
@ -350,7 +351,7 @@ intervalTypeField (Itf n p) =
|
|||
pretty n
|
||||
<+> me (\(x,x1) ->
|
||||
parens (pretty (show x)
|
||||
<+> me (\y -> (sep [comma,pretty (show y)])) x1)) p
|
||||
<+> me (\y -> sep [comma,pretty (show y)]) x1)) p
|
||||
|
||||
|
||||
-- = query expressions
|
||||
|
|
@ -524,7 +525,7 @@ statement d (AlterDomain nm act) =
|
|||
<+> a act
|
||||
where
|
||||
a (ADSetDefault v) = texts ["set","default"] <+> scalarExpr d v
|
||||
a (ADDropDefault) = texts ["drop","default"]
|
||||
a ADDropDefault = texts ["drop","default"]
|
||||
a (ADAddConstraint cnm e) =
|
||||
pretty "add"
|
||||
<+> maybe mempty (\cnm' -> pretty "constraint" <+> names cnm') cnm
|
||||
|
|
@ -603,7 +604,7 @@ statement _ (DropTable n b) =
|
|||
statement d (CreateView r nm al q co) =
|
||||
pretty "create" <+> (if r then pretty "recursive" else mempty)
|
||||
<+> pretty "view" <+> names nm
|
||||
<+> (maybe mempty (\al' -> parens $ commaSep $ map name al')) al
|
||||
<+> maybe mempty (parens . commaSep . map name) al
|
||||
<+> pretty "as"
|
||||
<+> queryExpr d q
|
||||
<+> case co of
|
||||
|
|
@ -731,7 +732,7 @@ columnDef d (ColumnDef n t mdef cons) =
|
|||
pcon (ColReferencesConstraint tb c m u del) =
|
||||
pretty "references"
|
||||
<+> names tb
|
||||
<+> maybe mempty (\c' -> parens (name c')) c
|
||||
<+> maybe mempty (parens . name) c
|
||||
<+> refMatch m
|
||||
<+> refAct "update" u
|
||||
<+> refAct "delete" del
|
||||
|
|
|
|||
Loading…
Reference in a new issue