From 55a75371084405e10d387e219ba9d7c8b9e12b88 Mon Sep 17 00:00:00 2001 From: Jake Wheat Date: Wed, 10 Jan 2024 09:34:17 +0000 Subject: [PATCH] clean up some warnings, remove parsec dep, fix a temp commented out test --- Language/SQL/SimpleSQL/Lex.hs | 4 +-- Language/SQL/SimpleSQL/Parse.hs | 37 ++++++++++----------------- Language/SQL/SimpleSQL/Pretty.hs | 1 - simple-sql-parser.cabal | 1 - tools/Language/SQL/SimpleSQL/Tests.hs | 6 ++--- 5 files changed, 19 insertions(+), 30 deletions(-) diff --git a/Language/SQL/SimpleSQL/Lex.hs b/Language/SQL/SimpleSQL/Lex.hs index f804d57..3e87412 100644 --- a/Language/SQL/SimpleSQL/Lex.hs +++ b/Language/SQL/SimpleSQL/Lex.hs @@ -64,7 +64,7 @@ module Language.SQL.SimpleSQL.Lex ,lexSQL ,prettyToken ,prettyTokens - ,ParseError(..) + ,ParseError ,prettyError ,tokenListWillPrintAndLex ,ansi2011 @@ -252,7 +252,7 @@ sqlToken d = do -------------------------------------- sqlString :: Dialect -> Parser Token -sqlString d = +sqlString _d = SqlString "'" "'" <$> (char_ '\'' *> takeWhileP (Just "non quote char") (/= '\'') <* char_ '\'') {- diff --git a/Language/SQL/SimpleSQL/Parse.hs b/Language/SQL/SimpleSQL/Parse.hs index 97e5673..f181c9f 100644 --- a/Language/SQL/SimpleSQL/Parse.hs +++ b/Language/SQL/SimpleSQL/Parse.hs @@ -187,7 +187,7 @@ module Language.SQL.SimpleSQL.Parse ,parseScalarExpr ,parseStatement ,parseStatements - ,ParseError(..) + ,ParseError ,prettyError ) where @@ -199,9 +199,8 @@ import Text.Megaparsec ,PosState(..) ,TraversableStream(..) ,VisualStream(..) - ,ErrorItem(Tokens) + --,ErrorItem(Tokens) - ,initialPos ,sourceLine ,ParseErrorBundle(..) @@ -225,7 +224,7 @@ import qualified Control.Monad.Combinators.Expr as E import qualified Control.Monad.Permutations as P import Control.Monad.Reader - (Reader(..) + (Reader ,runReader ,ask ) @@ -233,14 +232,13 @@ import Control.Monad.Reader import qualified Data.List as DL import qualified Data.List.NonEmpty as NE import qualified Data.Set as Set -import Control.Monad.Identity (Identity) import Data.Proxy (Proxy(..)) import Data.Void (Void) import Control.Monad (guard, void) import Control.Applicative ((<**>)) -import Data.Char (toLower, isDigit) -import Data.List (intercalate,sort,groupBy) +import Data.Char (isDigit) +import Data.List (sort,groupBy) import Data.Function (on) import Data.Maybe (catMaybes, isJust) import Data.Text (Text) @@ -1239,15 +1237,15 @@ opTable bExpr = ] where - binarySymL name = E.InfixL (mkBinOp name <$ symbol_ name) - binarySymR name = E.InfixR (mkBinOp name <$ symbol_ name) - binarySymN name = E.InfixN (mkBinOp name <$ symbol_ name) - binaryKeywordN name = E.InfixN (mkBinOp name <$ keyword_ name) - binaryKeywordL name = E.InfixL (mkBinOp name <$ keyword_ name) - mkBinOp nm a b = BinOp a (mkName nm) b - prefixSym name = E.Prefix (PrefixOp (mkName name) <$ symbol_ name) - prefixKeyword name = E.Prefix (PrefixOp (mkName name) <$ keyword_ name) - mkName nm = [Name Nothing nm] + binarySymL nm = E.InfixL (mkBinOp nm <$ symbol_ nm) + binarySymR nm = E.InfixR (mkBinOp nm <$ symbol_ nm) + binarySymN nm = E.InfixN (mkBinOp nm <$ symbol_ nm) + binaryKeywordN nm = E.InfixN (mkBinOp nm <$ keyword_ nm) + binaryKeywordL nm = E.InfixL (mkBinOp nm <$ keyword_ nm) + mkBinOp nm a b = BinOp a (mkNm nm) b + prefixSym nm = E.Prefix (PrefixOp (mkNm nm) <$ symbol_ nm) + prefixKeyword nm = E.Prefix (PrefixOp (mkNm nm) <$ keyword_ nm) + mkNm nm = [Name Nothing nm] binaryKeywordsN p = E.InfixN (do o <- try p @@ -2161,11 +2159,6 @@ other operators so it can be used nicely () :: Parser a -> Parser (a -> a) -> Parser a p q = p <**> option id q -() :: Parser (a -> a) -> Parser (a -> a) -> Parser (a -> a) -() pa pb = (.) `c` pa <*> option id pb - -- todo: fix this mess - where c = (<$>) . flip - -- 0 to many repeated applications of suffix parser () :: Parser a -> Parser (a -> a) -> Parser a @@ -2482,5 +2475,3 @@ pxy = Proxy showMyToken :: L.Token -> String -- todo: how to do this properly? showMyToken = T.unpack . L.prettyToken ansi2011 - - diff --git a/Language/SQL/SimpleSQL/Pretty.hs b/Language/SQL/SimpleSQL/Pretty.hs index 1d942b6..8de4c08 100644 --- a/Language/SQL/SimpleSQL/Pretty.hs +++ b/Language/SQL/SimpleSQL/Pretty.hs @@ -37,7 +37,6 @@ import qualified Prettyprinter as P import Prettyprinter.Render.Text (renderStrict) import Data.Maybe (maybeToList, catMaybes) -import Data.List (intercalate) import qualified Data.Text as T import Data.Text (Text) diff --git a/simple-sql-parser.cabal b/simple-sql-parser.cabal index 31612eb..c7ed54a 100644 --- a/simple-sql-parser.cabal +++ b/simple-sql-parser.cabal @@ -36,7 +36,6 @@ common shared-properties build-depends: base >=4 && <5, megaparsec >=9.6 && <9.7, parser-combinators >= 1.3 && < 1.4, - parsec, mtl >=2.1 && <2.4, prettyprinter >= 1.7 && < 1.8, text >= 2.1 && < 2.2, diff --git a/tools/Language/SQL/SimpleSQL/Tests.hs b/tools/Language/SQL/SimpleSQL/Tests.hs index 1f107ad..272329e 100644 --- a/tools/Language/SQL/SimpleSQL/Tests.hs +++ b/tools/Language/SQL/SimpleSQL/Tests.hs @@ -118,9 +118,9 @@ makeLexerTest d s ts = H.testCase (T.unpack s) $ do makeLexingFailsTest :: Dialect -> Text -> T.TestTree makeLexingFailsTest d s = H.testCase (T.unpack s) $ do - undefined {-case lexSQL d "" Nothing s of - Right x -> H.assertFailure $ "lexing should have failed: " ++ s ++ "\ngot: " ++ show x - Left _ -> return ()-} + case Lex.lexSQL d "" Nothing s of + Right x -> H.assertFailure $ "lexing should have failed: " ++ T.unpack s ++ "\ngot: " ++ show x + Left _ -> pure () toTest :: (Eq a, Show a) =>