Make sure we only import directory

Author: safareli

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

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,16 +895,19 @@ 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
   start ← Gen.elements $ "a" :| S.split (S.Pattern "") "bcdefghijklmnopqrstuvwxyz"
   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

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`
   """