move path related staff to separate module

Author: safareli

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

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]

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

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

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