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

Commit

Permalink
move path related staff to separate module
Browse files Browse the repository at this point in the history
  • Loading branch information
safareli committed Dec 21, 2017
1 parent 7d02797 commit b7aae7e
Show file tree
Hide file tree
Showing 5 changed files with 69 additions and 55 deletions.
12 changes: 3 additions & 9 deletions src/SqlSquared/Parser.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
52 changes: 52 additions & 0 deletions src/SqlSquared/Path.purs
Original file line number Diff line number Diff line change
@@ -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.LeftPt.unsandbox <$> PtGen.genAbsFilePath)
:| [E.RightPt.unsandbox <$> PtGen.genRelFilePath]

genAnyDirPath :: forall m. Gen.MonadGen m => MonadRec m => m AnyDirPath
genAnyDirPath = Gen.oneOf
$ (E.LeftPt.unsandbox <$> PtGen.genAbsDirPath)
:| [E.RightPt.unsandbox <$> PtGen.genRelDirPath]
30 changes: 6 additions & 24 deletions src/SqlSquared/Signature.purs
Original file line number Diff line number Diff line change
Expand Up @@ -11,8 +11,6 @@ module SqlSquared.Signature
, SqlDeclF(..)
, SqlQueryF(..)
, SqlModuleF(..)
, AnyDirPath
, parseAnyDirPath
, printSqlF
, printSqlDeclF
, printSqlQueryF
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
28 changes: 7 additions & 21 deletions src/SqlSquared/Signature/Relation.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -38,7 +36,7 @@ type VariRelR =
}

type TableRelR =
{ path Either (Pt.AbsFile Pt.Unsandboxed) (Pt.RelFile Pt.Unsandboxed)
{ path Pt.AnyFilePath
, alias Maybe String
}

Expand Down Expand Up @@ -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 } →
Expand All @@ -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 } →
Expand Down Expand Up @@ -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")
(RightRight)
(RightLeft)
pathStr
path ← Pt.parseAnyFilePath Left pathStr
alias ← obj J..? "alias"
pure $ TableRelation { path, alias }

Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion test/src/Parse.purs
Original file line number Diff line number Diff line change
Expand Up @@ -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")
Expand Down

0 comments on commit b7aae7e

Please sign in to comment.