Skip to content
This repository was archived by the owner on Jun 15, 2023. It is now read-only.

Commit b7aae7e

Browse files
committed
move path related staff to separate module
1 parent 7d02797 commit b7aae7e

File tree

5 files changed

+69
-55
lines changed

5 files changed

+69
-55
lines changed

src/SqlSquared/Parser.purs

Lines changed: 3 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ import Data.Maybe (Maybe(..), fromMaybe, isJust)
2424
import Data.NonEmpty ((:|))
2525
import Data.Json.Extended as EJ
2626
import Data.Tuple (Tuple(..), uncurry)
27-
import Data.Path.Pathy as Pt
27+
import SqlSquared.Path as Pt
2828
import Data.String as S
2929

3030
import SqlSquared.Constructors as C
@@ -412,7 +412,7 @@ import_
412412
import_ = asErrorMessage "import declaration" do
413413
_ ← keyword "import"
414414
s ← ident
415-
path ← Sig.parseAnyDirPath P.fail s
415+
path ← Pt.parseAnyDirPath P.fail s
416416
pure $ Sig.Import path
417417

418418
variable m t. SqlParser' m t
@@ -572,13 +572,7 @@ parenRelation = do
572572
tableRelation m t. SqlParser m t (Sig.Relation t)
573573
tableRelation = do
574574
i ← ident
575-
path ←
576-
Pt.parsePath
577-
(const $ P.fail "incorrect path")
578-
(const $ P.fail "incorrect path")
579-
(pure ∘ E.Right)
580-
(pure ∘ E.Left)
581-
i
575+
path ← Pt.parseAnyFilePath P.fail i
582576
a ← PC.optionMaybe do
583577
_ ← keyword "as"
584578
ident

src/SqlSquared/Path.purs

Lines changed: 52 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,52 @@
1+
module SqlSquared.Path
2+
( AnyFilePath
3+
, AnyDirPath
4+
, parseAnyFilePath
5+
, printAnyFilePath
6+
, parseAnyDirPath
7+
, printAnyDirPath
8+
, genAnyFilePath
9+
, genAnyDirPath
10+
) where
11+
12+
import Prelude
13+
import Data.Either as E
14+
import Data.NonEmpty ((:|))
15+
import Data.Path.Pathy as Pt
16+
import Data.Path.Pathy.Gen as PtGen
17+
import Control.Monad.Gen as Gen
18+
import Control.Monad.Rec.Class (class MonadRec)
19+
import SqlSquared.Utils ((∘))
20+
21+
type AnyDirPath = E.Either (Pt.AbsDir Pt.Unsandboxed) (Pt.RelDir Pt.Unsandboxed)
22+
type AnyFilePath = E.Either (Pt.AbsFile Pt.Unsandboxed) (Pt.RelFile Pt.Unsandboxed)
23+
24+
printAnyDirPath :: AnyDirPath -> String
25+
printAnyDirPath = E.either Pt.unsafePrintPath Pt.unsafePrintPath
26+
27+
parseAnyDirPath :: forall m. Applicative m => (forall a. String -> m a) -> String -> m AnyDirPath
28+
parseAnyDirPath fail = Pt.parsePath
29+
(pure ∘ E.Right)
30+
(pure ∘ E.Left)
31+
(const $ fail "Expected a directory path")
32+
(const $ fail "Expected a directory path")
33+
34+
printAnyFilePath :: AnyFilePath -> String
35+
printAnyFilePath = E.either Pt.unsafePrintPath Pt.unsafePrintPath
36+
37+
parseAnyFilePath :: forall m. Applicative m => (forall a. String -> m a) -> String -> m AnyFilePath
38+
parseAnyFilePath fail = Pt.parsePath
39+
(const $ fail "Expected a file path")
40+
(const $ fail "Expected a file path")
41+
(pure ∘ E.Right)
42+
(pure ∘ E.Left)
43+
44+
genAnyFilePath :: forall m. Gen.MonadGen m => MonadRec m => m AnyFilePath
45+
genAnyFilePath = Gen.oneOf
46+
$ (E.LeftPt.unsandbox <$> PtGen.genAbsFilePath)
47+
:| [E.RightPt.unsandbox <$> PtGen.genRelFilePath]
48+
49+
genAnyDirPath :: forall m. Gen.MonadGen m => MonadRec m => m AnyDirPath
50+
genAnyDirPath = Gen.oneOf
51+
$ (E.LeftPt.unsandbox <$> PtGen.genAbsDirPath)
52+
:| [E.RightPt.unsandbox <$> PtGen.genRelDirPath]

src/SqlSquared/Signature.purs

Lines changed: 6 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -11,8 +11,6 @@ module SqlSquared.Signature
1111
, SqlDeclF(..)
1212
, SqlQueryF(..)
1313
, SqlModuleF(..)
14-
, AnyDirPath
15-
, parseAnyDirPath
1614
, printSqlF
1715
, printSqlDeclF
1816
, printSqlQueryF
@@ -60,13 +58,12 @@ import Data.Maybe (Maybe(..))
6058
import Data.Monoid (mempty)
6159
import Data.Newtype (class Newtype)
6260
import Data.NonEmpty ((:|))
63-
import Data.Path.Pathy as Pt
64-
import Data.Path.Pathy.Gen as PtGen
6561
import Data.Ord (class Ord1, compare1)
6662
import Data.String as S
6763
import Data.String.Gen as GenS
6864
import Data.Traversable as T
6965
import Matryoshka (Algebra, CoalgebraM, class Corecursive, embed)
66+
import SqlSquared.Path as Pt
7067
import SqlSquared.Signature.BinaryOperator as BO
7168
import SqlSquared.Signature.Case as CS
7269
import SqlSquared.Signature.GroupBy as GB
@@ -142,20 +139,8 @@ data SqlF literal a
142139
| Select (SelectR a)
143140
| Parens a
144141

145-
type AnyDirPath = E.Either (Pt.AbsDir Pt.Unsandboxed) (Pt.RelDir Pt.Unsandboxed)
146-
147-
printAnyDirPath :: AnyDirPath -> String
148-
printAnyDirPath = E.either Pt.unsafePrintPath Pt.unsafePrintPath
149-
150-
parseAnyDirPath :: forall m. Applicative m => (forall a. String -> m a) -> String -> m AnyDirPath
151-
parseAnyDirPath fail = Pt.parsePath
152-
(pure ∘ E.Right)
153-
(pure ∘ E.Left)
154-
(const $ fail "incorrect directory path")
155-
(const $ fail "incorrect directory path")
156-
157142
data SqlDeclF a
158-
= Import AnyDirPath
143+
= Import Pt.AnyDirPath
159144
| FunctionDecl (FunctionDeclR a)
160145

161146
newtype SqlModuleF a =
@@ -519,7 +504,7 @@ printSqlDeclF = case _ of
519504
<> body
520505
<> " END"
521506
Import path →
522-
"IMPORT " <> ID.printIdent (printAnyDirPath path)
507+
"IMPORT " <> ID.printIdent (Pt.printAnyDirPath path)
523508

524509
printSqlQueryF Algebra SqlQueryF String
525510
printSqlQueryF (Query decls expr) = F.intercalate "; " $ L.snoc (printSqlDeclF <$> decls) expr
@@ -606,7 +591,7 @@ encodeJsonSqlDeclF = case _ of
606591
J.~> J.jsonEmptyObject
607592
Import path →
608593
"tag" J.:= "import"
609-
J.~> "value" J.:= printAnyDirPath path
594+
J.~> "value" J.:= Pt.printAnyDirPath path
610595
J.~> J.jsonEmptyObject
611596

612597
encodeJsonSqlQueryF Algebra SqlQueryF J.Json
@@ -728,7 +713,7 @@ decodeJsonSqlDeclF = J.decodeJson >=> \obj → do
728713

729714
decodeImport obj = do
730715
v ← obj J..? "value"
731-
path ← parseAnyDirPath E.Left v
716+
path ← Pt.parseAnyDirPath E.Left v
732717
pure $ Import path
733718

734719
decodeJsonSqlQueryF CoalgebraM (E.Either String) SqlQueryF J.Json
@@ -896,10 +881,7 @@ genFunctionDecl n = do
896881
pure $ FunctionDecl { ident, args, body: n - 1 }
897882

898883
genImport m a. Gen.MonadGen m MonadRec m m (SqlDeclF a)
899-
genImport = map Import
900-
$ Gen.oneOf
901-
$ (Pt.unsandbox >>> E.Left <$> PtGen.genAbsDirPath)
902-
:| [Pt.unsandbox >>> E.Right <$> PtGen.genRelDirPath]
884+
genImport = map Import Pt.genAnyDirPath
903885

904886
genIdent m. Gen.MonadGen m m String
905887
genIdent = do

src/SqlSquared/Signature/Relation.purs

Lines changed: 7 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -6,20 +6,18 @@ import Control.Monad.Gen as Gen
66
import Control.Monad.Gen.Common as GenC
77
import Control.Monad.Rec.Class (class MonadRec)
88
import Data.Argonaut as J
9-
import Data.Either (Either(..), either)
9+
import Data.Either (Either(..))
1010
import Data.Foldable as F
11-
import Data.Int as Int
1211
import Data.Maybe (Maybe)
1312
import Data.Monoid (mempty)
1413
import Data.NonEmpty ((:|))
15-
import Data.Path.Pathy as Pt
1614
import Data.String.Gen as GenS
1715
import Data.Traversable as T
1816
import Matryoshka (Algebra, CoalgebraM)
17+
import SqlSquared.Path as Pt
1918
import SqlSquared.Signature.Ident as ID
2019
import SqlSquared.Signature.JoinType as JT
2120
import SqlSquared.Utils ((∘))
22-
2321
type JoinRelR a =
2422
{ left Relation a
2523
, right Relation a
@@ -38,7 +36,7 @@ type VariRelR =
3836
}
3937

4038
type TableRelR =
41-
{ path Either (Pt.AbsFile Pt.Unsandboxed) (Pt.RelFile Pt.Unsandboxed)
39+
{ path Pt.AnyFilePath
4240
, alias Maybe String
4341
}
4442

@@ -91,7 +89,7 @@ printRelation = case _ of
9189
":" <> ID.printIdent vari <> F.foldMap (\a → " AS " <> ID.printIdent a) alias
9290
TableRelation { path, alias } →
9391
"`"
94-
<> either Pt.unsafePrintPath Pt.unsafePrintPath path
92+
<> Pt.printAnyFilePath path
9593
<> "`"
9694
<> F.foldMap (\x → " AS " <> ID.printIdent x) alias
9795
JoinRelation { left, right, joinType, clause } →
@@ -117,7 +115,7 @@ encodeJsonRelation = case _ of
117115
J.~> J.jsonEmptyObject
118116
TableRelation { path, alias } →
119117
"tag" J.:= "table relation"
120-
J.~> "path" J.:= either Pt.unsafePrintPath Pt.unsafePrintPath path
118+
J.~> "path" J.:= Pt.printAnyFilePath path
121119
J.~> "alias" J.:= alias
122120
J.~> J.jsonEmptyObject
123121
JoinRelation { left, right, joinType, clause } →
@@ -150,13 +148,7 @@ decodeJsonRelation = J.decodeJson >=> \obj → do
150148

151149
decodeTableRelation obj = do
152150
pathStr ← obj J..? "path"
153-
path ←
154-
Pt.parsePath
155-
(const $ Left "incorrect path")
156-
(const $ Left "incorrect path")
157-
(RightRight)
158-
(RightLeft)
159-
pathStr
151+
path ← Pt.parseAnyFilePath Left pathStr
160152
alias ← obj J..? "alias"
161153
pure $ TableRelation { path, alias }
162154

@@ -186,13 +178,7 @@ genRelation n =
186178
alias ← GenC.genMaybe GenS.genUnicodeString
187179
pure $ VariRelation { vari, alias }
188180
genTable = do
189-
let
190-
pathPart =
191-
map (Int.toStringAs Int.hexadecimal) (Gen.chooseInt 0 100000)
192-
dirs ← map Pt.dir <$> Gen.resize (const n) (Gen.unfoldable pathPart m (Array String))
193-
fileName ← map Pt.file pathPart
194-
let
195-
path = Left $ Pt.rootDir Pt.</> F.foldl (\a b → b Pt.</> a) fileName dirs
181+
path ← Pt.genAnyFilePath
196182
alias ← GenC.genMaybe GenS.genUnicodeString
197183
pure $ TableRelation { path, alias }
198184
genExpr = do

test/src/Parse.purs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -72,7 +72,7 @@ testSuite1 ∷ ∀ e. TestSuite (testOutput ∷ Console.TESTOUTPUT | e)
7272
testSuite1 = do
7373
parseFailWith """
7474
import `/path/To/Your/File/myModule`; SELECT id("HELLO")
75-
""" "(ParseError \"incorrect directory path\" (Position { line: 2, column: 12 }))"
75+
""" "(ParseError \"Expected a directory path\" (Position { line: 2, column: 12 }))"
7676

7777
parseSucc """
7878
import `/path/To/Your/File/myModule/`; SELECT id("HELLO")

0 commit comments

Comments
 (0)