From 7d02797315a5a83830f6c86f78177ec71ae4cbce Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Wed, 20 Dec 2017 22:10:15 +0100 Subject: [PATCH 1/2] Make sure we only `import` directory --- src/SqlSquared/Parser.purs | 3 ++- src/SqlSquared/Signature.purs | 44 +++++++++++++++++++++++++---------- test/src/Parse.purs | 31 ++++++++++++++++++++++++ 3 files changed, 65 insertions(+), 13 deletions(-) diff --git a/src/SqlSquared/Parser.purs b/src/SqlSquared/Parser.purs index 436a2eb..823d542 100644 --- a/src/SqlSquared/Parser.purs +++ b/src/SqlSquared/Parser.purs @@ -412,7 +412,8 @@ import_ import_ = asErrorMessage "import declaration" do _ ← keyword "import" s ← ident - pure $ Sig.Import s + path ← Sig.parseAnyDirPath P.fail s + pure $ Sig.Import path variable ∷ ∀ m t. SqlParser' m t variable = C.vari <$> variableString diff --git a/src/SqlSquared/Signature.purs b/src/SqlSquared/Signature.purs index b492d95..7c87c74 100644 --- a/src/SqlSquared/Signature.purs +++ b/src/SqlSquared/Signature.purs @@ -11,6 +11,8 @@ module SqlSquared.Signature , SqlDeclF(..) , SqlQueryF(..) , SqlModuleF(..) + , AnyDirPath + , parseAnyDirPath , printSqlF , printSqlDeclF , printSqlQueryF @@ -58,6 +60,8 @@ import Data.Maybe (Maybe(..)) import Data.Monoid (mempty) import Data.Newtype (class Newtype) import Data.NonEmpty ((:|)) +import Data.Path.Pathy as Pt +import Data.Path.Pathy.Gen as PtGen import Data.Ord (class Ord1, compare1) import Data.String as S import Data.String.Gen as GenS @@ -138,8 +142,20 @@ data SqlF literal a | Select (SelectR a) | Parens a +type AnyDirPath = E.Either (Pt.AbsDir Pt.Unsandboxed) (Pt.RelDir Pt.Unsandboxed) + +printAnyDirPath :: AnyDirPath -> String +printAnyDirPath = E.either Pt.unsafePrintPath Pt.unsafePrintPath + +parseAnyDirPath :: forall m. Applicative m => (forall a. String -> m a) -> String -> m AnyDirPath +parseAnyDirPath fail = Pt.parsePath + (pure ∘ E.Right) + (pure ∘ E.Left) + (const $ fail "incorrect directory path") + (const $ fail "incorrect directory path") + data SqlDeclF a - = Import String + = Import AnyDirPath | FunctionDecl (FunctionDeclR a) newtype SqlModuleF a = @@ -502,8 +518,8 @@ printSqlDeclF = case _ of <> "(" <> F.intercalate ", " (append ":" ∘ ID.printIdent <$> args) <> ") BEGIN " <> body <> " END" - Import s → - "IMPORT " <> ID.printIdent s + Import path → + "IMPORT " <> ID.printIdent (printAnyDirPath path) printSqlQueryF ∷ Algebra SqlQueryF String printSqlQueryF (Query decls expr) = F.intercalate "; " $ L.snoc (printSqlDeclF <$> decls) expr @@ -588,9 +604,9 @@ encodeJsonSqlDeclF = case _ of J.~> "args" J.:= args J.~> "body" J.:= body J.~> J.jsonEmptyObject - Import s → + Import path → "tag" J.:= "import" - J.~> "value" J.:= s + J.~> "value" J.:= printAnyDirPath path J.~> J.jsonEmptyObject encodeJsonSqlQueryF ∷ Algebra SqlQueryF J.Json @@ -712,7 +728,8 @@ decodeJsonSqlDeclF = J.decodeJson >=> \obj → do decodeImport obj = do v ← obj J..? "value" - pure $ Import v + path ← parseAnyDirPath E.Left v + pure $ Import path decodeJsonSqlQueryF ∷ CoalgebraM (E.Either String) SqlQueryF J.Json decodeJsonSqlQueryF = J.decodeJson >=> \obj → do @@ -761,16 +778,16 @@ genSqlF genLiteral n , genSelect n ] -genSqlDeclF ∷ ∀ m. Gen.MonadGen m ⇒ CoalgebraM m SqlDeclF Int +genSqlDeclF ∷ ∀ m. Gen.MonadGen m ⇒ MonadRec m ⇒ CoalgebraM m SqlDeclF Int genSqlDeclF n = Gen.oneOf $ genImport :| [ genFunctionDecl n ] -genSqlQueryF ∷ ∀ m. Gen.MonadGen m ⇒ CoalgebraM m SqlQueryF Int +genSqlQueryF ∷ ∀ m. Gen.MonadGen m ⇒ MonadRec m ⇒ CoalgebraM m SqlQueryF Int genSqlQueryF n = Query <$> genDecls n <*> pure n -genSqlModuleF ∷ ∀ m. Gen.MonadGen m ⇒ CoalgebraM m SqlModuleF Int +genSqlModuleF ∷ ∀ m. Gen.MonadGen m ⇒ MonadRec m ⇒ CoalgebraM m SqlModuleF Int genSqlModuleF n = Module <$> genDecls n genSetLiteral ∷ ∀ m l. Gen.MonadGen m ⇒ CoalgebraM m (SqlF l) Int @@ -878,8 +895,11 @@ genFunctionDecl n = do args ← L.foldM foldFn L.Nil $ L.range 0 len pure $ FunctionDecl { ident, args, body: n - 1 } -genImport ∷ ∀ m a. Gen.MonadGen m ⇒ m (SqlDeclF a) -genImport = Import <$> genIdent +genImport ∷ ∀ m a. Gen.MonadGen m ⇒ MonadRec m ⇒ m (SqlDeclF a) +genImport = map Import + $ Gen.oneOf + $ (Pt.unsandbox >>> E.Left <$> PtGen.genAbsDirPath) + :| [Pt.unsandbox >>> E.Right <$> PtGen.genRelDirPath] genIdent ∷ ∀ m. Gen.MonadGen m ⇒ m String genIdent = do @@ -887,7 +907,7 @@ genIdent = do body ← map (Int.toStringAs Int.hexadecimal) (Gen.chooseInt 0 100000) pure $ start <> body -genDecls ∷ ∀ m. Gen.MonadGen m ⇒ Int → m (L.List (SqlDeclF Int)) +genDecls ∷ ∀ m. Gen.MonadGen m ⇒ MonadRec m ⇒ Int → m (L.List (SqlDeclF Int)) genDecls n = do let foldFn acc _ = do diff --git a/test/src/Parse.purs b/test/src/Parse.purs index 012e923..99f8b77 100644 --- a/test/src/Parse.purs +++ b/test/src/Parse.purs @@ -40,6 +40,25 @@ parseFail s = E.Left err → pure unit E.Right (sql ∷ SqlQuery) → Assert.assert s false +parseFailWith ∷ ∀ e. String → String → TestSuite (testOutput ∷ Console.TESTOUTPUT | e) +parseFailWith s err = + test "parse/failWith" + case parseQuery s of + E.Left err' → + if show err' == err + then pure unit + else Assert.assert + ("expected query:" <> s <> + "\n\n to fail input error: " <> err <> + "\n\n but instead fot error: " <> show err') + false + E.Right (sql ∷ SqlQuery) → + Assert.assert + ("expected to fail with:" <> err <> + "\n\tbut input query:" <> s <> + "\n\twas parsed as:" <> printQuery sql) + false + testSuite ∷ ∀ e. TestSuite (testOutput ∷ Console.TESTOUTPUT | e) testSuite = suite "parsers" do testSuite1 @@ -51,6 +70,14 @@ testSuite = suite "parsers" do testSuite1 ∷ ∀ e. TestSuite (testOutput ∷ Console.TESTOUTPUT | e) testSuite1 = do + parseFailWith """ + import `/path/To/Your/File/myModule`; SELECT id("HELLO") + """ "(ParseError \"incorrect directory path\" (Position { line: 2, column: 12 }))" + + parseSucc """ + import `/path/To/Your/File/myModule/`; SELECT id("HELLO") + """ + parseSucc """ a := 1; SELECT * FROM `/test` """ @@ -157,6 +184,10 @@ testSuite1 = do """ parseSucc """ + import `foo/`; select * from `/test` + """ + + parseFail """ import foo; select * from `/test` """ From b7aae7e4e119d9093955b065d98e77bee1094c8e Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Thu, 21 Dec 2017 13:43:53 +0100 Subject: [PATCH 2/2] move path related staff to separate module --- src/SqlSquared/Parser.purs | 12 ++---- src/SqlSquared/Path.purs | 52 ++++++++++++++++++++++++++ src/SqlSquared/Signature.purs | 30 +++------------ src/SqlSquared/Signature/Relation.purs | 28 ++++---------- test/src/Parse.purs | 2 +- 5 files changed, 69 insertions(+), 55 deletions(-) create mode 100644 src/SqlSquared/Path.purs diff --git a/src/SqlSquared/Parser.purs b/src/SqlSquared/Parser.purs index 823d542..ab2fec0 100644 --- a/src/SqlSquared/Parser.purs +++ b/src/SqlSquared/Parser.purs @@ -24,7 +24,7 @@ import Data.Maybe (Maybe(..), fromMaybe, isJust) import Data.NonEmpty ((:|)) import Data.Json.Extended as EJ import Data.Tuple (Tuple(..), uncurry) -import Data.Path.Pathy as Pt +import SqlSquared.Path as Pt import Data.String as S import SqlSquared.Constructors as C @@ -412,7 +412,7 @@ import_ import_ = asErrorMessage "import declaration" do _ ← keyword "import" s ← ident - path ← Sig.parseAnyDirPath P.fail s + path ← Pt.parseAnyDirPath P.fail s pure $ Sig.Import path variable ∷ ∀ m t. SqlParser' m t @@ -572,13 +572,7 @@ parenRelation = do tableRelation ∷ ∀ m t. SqlParser m t (Sig.Relation t) tableRelation = do i ← ident - path ← - Pt.parsePath - (const $ P.fail "incorrect path") - (const $ P.fail "incorrect path") - (pure ∘ E.Right) - (pure ∘ E.Left) - i + path ← Pt.parseAnyFilePath P.fail i a ← PC.optionMaybe do _ ← keyword "as" ident diff --git a/src/SqlSquared/Path.purs b/src/SqlSquared/Path.purs new file mode 100644 index 0000000..116eb6b --- /dev/null +++ b/src/SqlSquared/Path.purs @@ -0,0 +1,52 @@ +module SqlSquared.Path + ( AnyFilePath + , AnyDirPath + , parseAnyFilePath + , printAnyFilePath + , parseAnyDirPath + , printAnyDirPath + , genAnyFilePath + , genAnyDirPath + ) where + +import Prelude +import Data.Either as E +import Data.NonEmpty ((:|)) +import Data.Path.Pathy as Pt +import Data.Path.Pathy.Gen as PtGen +import Control.Monad.Gen as Gen +import Control.Monad.Rec.Class (class MonadRec) +import SqlSquared.Utils ((∘)) + +type AnyDirPath = E.Either (Pt.AbsDir Pt.Unsandboxed) (Pt.RelDir Pt.Unsandboxed) +type AnyFilePath = E.Either (Pt.AbsFile Pt.Unsandboxed) (Pt.RelFile Pt.Unsandboxed) + +printAnyDirPath :: AnyDirPath -> String +printAnyDirPath = E.either Pt.unsafePrintPath Pt.unsafePrintPath + +parseAnyDirPath :: forall m. Applicative m => (forall a. String -> m a) -> String -> m AnyDirPath +parseAnyDirPath fail = Pt.parsePath + (pure ∘ E.Right) + (pure ∘ E.Left) + (const $ fail "Expected a directory path") + (const $ fail "Expected a directory path") + +printAnyFilePath :: AnyFilePath -> String +printAnyFilePath = E.either Pt.unsafePrintPath Pt.unsafePrintPath + +parseAnyFilePath :: forall m. Applicative m => (forall a. String -> m a) -> String -> m AnyFilePath +parseAnyFilePath fail = Pt.parsePath + (const $ fail "Expected a file path") + (const $ fail "Expected a file path") + (pure ∘ E.Right) + (pure ∘ E.Left) + +genAnyFilePath :: forall m. Gen.MonadGen m => MonadRec m => m AnyFilePath +genAnyFilePath = Gen.oneOf + $ (E.Left ∘ Pt.unsandbox <$> PtGen.genAbsFilePath) + :| [E.Right ∘ Pt.unsandbox <$> PtGen.genRelFilePath] + +genAnyDirPath :: forall m. Gen.MonadGen m => MonadRec m => m AnyDirPath +genAnyDirPath = Gen.oneOf + $ (E.Left ∘ Pt.unsandbox <$> PtGen.genAbsDirPath) + :| [E.Right ∘ Pt.unsandbox <$> PtGen.genRelDirPath] diff --git a/src/SqlSquared/Signature.purs b/src/SqlSquared/Signature.purs index 7c87c74..cca8758 100644 --- a/src/SqlSquared/Signature.purs +++ b/src/SqlSquared/Signature.purs @@ -11,8 +11,6 @@ module SqlSquared.Signature , SqlDeclF(..) , SqlQueryF(..) , SqlModuleF(..) - , AnyDirPath - , parseAnyDirPath , printSqlF , printSqlDeclF , printSqlQueryF @@ -60,13 +58,12 @@ import Data.Maybe (Maybe(..)) import Data.Monoid (mempty) import Data.Newtype (class Newtype) import Data.NonEmpty ((:|)) -import Data.Path.Pathy as Pt -import Data.Path.Pathy.Gen as PtGen import Data.Ord (class Ord1, compare1) import Data.String as S import Data.String.Gen as GenS import Data.Traversable as T import Matryoshka (Algebra, CoalgebraM, class Corecursive, embed) +import SqlSquared.Path as Pt import SqlSquared.Signature.BinaryOperator as BO import SqlSquared.Signature.Case as CS import SqlSquared.Signature.GroupBy as GB @@ -142,20 +139,8 @@ data SqlF literal a | Select (SelectR a) | Parens a -type AnyDirPath = E.Either (Pt.AbsDir Pt.Unsandboxed) (Pt.RelDir Pt.Unsandboxed) - -printAnyDirPath :: AnyDirPath -> String -printAnyDirPath = E.either Pt.unsafePrintPath Pt.unsafePrintPath - -parseAnyDirPath :: forall m. Applicative m => (forall a. String -> m a) -> String -> m AnyDirPath -parseAnyDirPath fail = Pt.parsePath - (pure ∘ E.Right) - (pure ∘ E.Left) - (const $ fail "incorrect directory path") - (const $ fail "incorrect directory path") - data SqlDeclF a - = Import AnyDirPath + = Import Pt.AnyDirPath | FunctionDecl (FunctionDeclR a) newtype SqlModuleF a = @@ -519,7 +504,7 @@ printSqlDeclF = case _ of <> body <> " END" Import path → - "IMPORT " <> ID.printIdent (printAnyDirPath path) + "IMPORT " <> ID.printIdent (Pt.printAnyDirPath path) printSqlQueryF ∷ Algebra SqlQueryF String printSqlQueryF (Query decls expr) = F.intercalate "; " $ L.snoc (printSqlDeclF <$> decls) expr @@ -606,7 +591,7 @@ encodeJsonSqlDeclF = case _ of J.~> J.jsonEmptyObject Import path → "tag" J.:= "import" - J.~> "value" J.:= printAnyDirPath path + J.~> "value" J.:= Pt.printAnyDirPath path J.~> J.jsonEmptyObject encodeJsonSqlQueryF ∷ Algebra SqlQueryF J.Json @@ -728,7 +713,7 @@ decodeJsonSqlDeclF = J.decodeJson >=> \obj → do decodeImport obj = do v ← obj J..? "value" - path ← parseAnyDirPath E.Left v + path ← Pt.parseAnyDirPath E.Left v pure $ Import path decodeJsonSqlQueryF ∷ CoalgebraM (E.Either String) SqlQueryF J.Json @@ -896,10 +881,7 @@ genFunctionDecl n = do pure $ FunctionDecl { ident, args, body: n - 1 } genImport ∷ ∀ m a. Gen.MonadGen m ⇒ MonadRec m ⇒ m (SqlDeclF a) -genImport = map Import - $ Gen.oneOf - $ (Pt.unsandbox >>> E.Left <$> PtGen.genAbsDirPath) - :| [Pt.unsandbox >>> E.Right <$> PtGen.genRelDirPath] +genImport = map Import Pt.genAnyDirPath genIdent ∷ ∀ m. Gen.MonadGen m ⇒ m String genIdent = do diff --git a/src/SqlSquared/Signature/Relation.purs b/src/SqlSquared/Signature/Relation.purs index ecdf311..5ed38de 100644 --- a/src/SqlSquared/Signature/Relation.purs +++ b/src/SqlSquared/Signature/Relation.purs @@ -6,20 +6,18 @@ import Control.Monad.Gen as Gen import Control.Monad.Gen.Common as GenC import Control.Monad.Rec.Class (class MonadRec) import Data.Argonaut as J -import Data.Either (Either(..), either) +import Data.Either (Either(..)) import Data.Foldable as F -import Data.Int as Int import Data.Maybe (Maybe) import Data.Monoid (mempty) import Data.NonEmpty ((:|)) -import Data.Path.Pathy as Pt import Data.String.Gen as GenS import Data.Traversable as T import Matryoshka (Algebra, CoalgebraM) +import SqlSquared.Path as Pt import SqlSquared.Signature.Ident as ID import SqlSquared.Signature.JoinType as JT import SqlSquared.Utils ((∘)) - type JoinRelR a = { left ∷ Relation a , right ∷ Relation a @@ -38,7 +36,7 @@ type VariRelR = } type TableRelR = - { path ∷ Either (Pt.AbsFile Pt.Unsandboxed) (Pt.RelFile Pt.Unsandboxed) + { path ∷ Pt.AnyFilePath , alias ∷ Maybe String } @@ -91,7 +89,7 @@ printRelation = case _ of ":" <> ID.printIdent vari <> F.foldMap (\a → " AS " <> ID.printIdent a) alias TableRelation { path, alias } → "`" - <> either Pt.unsafePrintPath Pt.unsafePrintPath path + <> Pt.printAnyFilePath path <> "`" <> F.foldMap (\x → " AS " <> ID.printIdent x) alias JoinRelation { left, right, joinType, clause } → @@ -117,7 +115,7 @@ encodeJsonRelation = case _ of J.~> J.jsonEmptyObject TableRelation { path, alias } → "tag" J.:= "table relation" - J.~> "path" J.:= either Pt.unsafePrintPath Pt.unsafePrintPath path + J.~> "path" J.:= Pt.printAnyFilePath path J.~> "alias" J.:= alias J.~> J.jsonEmptyObject JoinRelation { left, right, joinType, clause } → @@ -150,13 +148,7 @@ decodeJsonRelation = J.decodeJson >=> \obj → do decodeTableRelation obj = do pathStr ← obj J..? "path" - path ← - Pt.parsePath - (const $ Left "incorrect path") - (const $ Left "incorrect path") - (Right ∘ Right) - (Right ∘ Left) - pathStr + path ← Pt.parseAnyFilePath Left pathStr alias ← obj J..? "alias" pure $ TableRelation { path, alias } @@ -186,13 +178,7 @@ genRelation n = alias ← GenC.genMaybe GenS.genUnicodeString pure $ VariRelation { vari, alias } genTable = do - let - pathPart = - map (Int.toStringAs Int.hexadecimal) (Gen.chooseInt 0 100000) - dirs ← map Pt.dir <$> Gen.resize (const n) (Gen.unfoldable pathPart ∷ m (Array String)) - fileName ← map Pt.file pathPart - let - path = Left $ Pt.rootDir Pt. F.foldl (\a b → b Pt. a) fileName dirs + path ← Pt.genAnyFilePath alias ← GenC.genMaybe GenS.genUnicodeString pure $ TableRelation { path, alias } genExpr = do diff --git a/test/src/Parse.purs b/test/src/Parse.purs index 99f8b77..3984cbd 100644 --- a/test/src/Parse.purs +++ b/test/src/Parse.purs @@ -72,7 +72,7 @@ testSuite1 ∷ ∀ e. TestSuite (testOutput ∷ Console.TESTOUTPUT | e) testSuite1 = do parseFailWith """ import `/path/To/Your/File/myModule`; SELECT id("HELLO") - """ "(ParseError \"incorrect directory path\" (Position { line: 2, column: 12 }))" + """ "(ParseError \"Expected a directory path\" (Position { line: 2, column: 12 }))" parseSucc """ import `/path/To/Your/File/myModule/`; SELECT id("HELLO")