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
@@ -140,8 +144,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 =
@@ -504,8 +520,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
@@ -590,9 +606,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
@@ -714,7 +730,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
@@ -879,7 +896,10 @@ genFunctionDecl n = do
   pure $ FunctionDecl { ident, args, body: n - 1 }
 
 genImport ∷ ∀ a. Gen.Gen (SqlDeclF a)
-genImport = Import <$> genIdent
+genImport = map Import
+  $ Gen.oneOf
+  $ (Pt.unsandbox >>> E.Left <$> PtGen.genAbsDirPath)
+  :| [Pt.unsandbox >>> E.Right <$> PtGen.genRelDirPath]
 
 genIdent ∷ Gen.Gen String
 genIdent = do

test/src/Gen.purs

@@ -2,11 +2,10 @@ module Test.Gen where
 
 import Prelude
 
-import Control.Monad.Eff (Eff, foreachE)
+import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Console (CONSOLE)
 import Control.Monad.Eff.Exception (EXCEPTION)
 import Control.Monad.Eff.Random (RANDOM)
-import Data.Array ((..))
 import Data.Either as E
 import SqlSquared (SqlQuery, arbitrarySqlQueryOfSize, decodeJsonQuery, encodeJsonQuery, printQuery, tokenize)
 import Test.QuickCheck ((<?>))

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 """
     select a from `/f` where b is not between 1 and (2..3)
   """
@@ -121,6 +148,10 @@ testSuite1 = do
   """
 
   parseSucc """
+    import `foo/`; select * from `/test`
+  """
+
+  parseFail """
     import foo; select * from `/test`
   """