From d9c48f5b934be2de39eb6c778e394c127fbecaea Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Fri, 16 Feb 2018 16:38:08 +0100 Subject: [PATCH 01/33] compiles --- bower.json | 9 +- src/Quasar/Advanced/Paths.purs | 29 +- .../Advanced/QuasarAF/Interpreter/Affjax.purs | 11 +- .../QuasarAF/Interpreter/Internal.purs | 4 +- src/Quasar/Advanced/Types.purs | 46 +-- src/Quasar/Data/URI.purs | 271 ++++++++++++++++++ src/Quasar/FS/Mount.purs | 10 +- src/Quasar/FS/Resource.purs | 10 +- src/Quasar/Internal.purs | 24 ++ src/Quasar/Mount/Common.purs | 45 +-- src/Quasar/Mount/Common/Gen.purs | 60 ++-- src/Quasar/Mount/Couchbase.purs | 67 +++-- src/Quasar/Mount/Couchbase/Gen.purs | 5 +- src/Quasar/Mount/MarkLogic.purs | 41 ++- src/Quasar/Mount/Mimir.purs | 10 +- src/Quasar/Mount/MongoDB.purs | 57 ++-- src/Quasar/Mount/MongoDB/Gen.purs | 2 +- src/Quasar/Mount/SparkHDFS.purs | 76 +++-- src/Quasar/Mount/SparkLocal.purs | 10 +- src/Quasar/Mount/View.purs | 39 ++- src/Quasar/Paths.purs | 22 +- src/Quasar/QuasarF/Interpreter/Affjax.purs | 40 ++- src/Quasar/QuasarF/Interpreter/Config.purs | 4 +- src/Quasar/QuasarF/Interpreter/Internal.purs | 81 +++--- test/src/Test/Main.purs | 29 +- test/src/Test/Unit/Main.purs | 22 +- 26 files changed, 683 insertions(+), 341 deletions(-) create mode 100644 src/Quasar/Data/URI.purs create mode 100644 src/Quasar/Internal.purs diff --git a/bower.json b/bower.json index e4276c1..c122665 100644 --- a/bower.json +++ b/bower.json @@ -25,8 +25,10 @@ "purescript-nonempty": "^4.1.1", "purescript-numbers": "^5.0.0", "purescript-oidc-crypt-utils": "^7.0.1", - "purescript-pathy": "^4.1.0", - "purescript-uri": "^4.2.3", + "purescript-pathy": "safareli/purescript-pathy#refactor", + "purescript-string-parsers": "^3.0.0", + "purescript-strings": "^3.5.0", + "purescript-uri": "garyb/purescript-uri#next", "purescript-sql-squared": "^0.10.0", "purescript-const": "^3.2.0" }, @@ -39,5 +41,8 @@ "purescript-quickcheck": "^4.6.1", "purescript-quasar-test-starter": "slamdata/quasar-test-starter#^1.0.0", "purescript-quickcheck-laws": "^3.0.1" + }, + "resolutions": { + "purescript-pathy": "refactor" } } diff --git a/src/Quasar/Advanced/Paths.purs b/src/Quasar/Advanced/Paths.purs index 3a378b4..e729ece 100644 --- a/src/Quasar/Advanced/Paths.purs +++ b/src/Quasar/Advanced/Paths.purs @@ -2,7 +2,7 @@ Copyright 2017 SlamData, Inc. Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. +you may not use this file_ except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 @@ -16,31 +16,38 @@ limitations under the License. module Quasar.Advanced.Paths where -import Data.Path.Pathy (RelDir, RelFile, Sandboxed, file, dir, ()) +import Data.Path.Pathy (RelDir, RelFile, Sandboxed, ()) +import Data.Symbol (SProxy(..)) +import Quasar.Internal (dir_, file_) oidcProviders ∷ RelFile Sandboxed -oidcProviders = dir "security" dir "oidc" file "providers" +oidcProviders = dir_ (SProxy :: SProxy "security") dir_ (SProxy :: SProxy "oidc") file_ (SProxy :: SProxy "providers") token ∷ RelDir Sandboxed -token = dir "security" dir "token" +token = dir_ (SProxy :: SProxy "security") dir_ (SProxy :: SProxy "token") group ∷ RelDir Sandboxed -group = dir "security" dir "group" +group = dir_ (SProxy :: SProxy "security") dir_ (SProxy :: SProxy "group") permission ∷ RelDir Sandboxed -permission = dir "security" dir "permission" +permission = dir_ (SProxy :: SProxy "security") dir_ (SProxy :: SProxy "permission") + +children ∷ RelFile Sandboxed +children = file_ (SProxy :: SProxy "children") authority ∷ RelDir Sandboxed -authority = dir "security" dir "authority" +authority = dir_ (SProxy :: SProxy "security") dir_ (SProxy :: SProxy "authority") licenseInfo ∷ RelFile Sandboxed -licenseInfo = dir "server" file "licenseInfo" +licenseInfo = dir_ (SProxy :: SProxy "server") file_ (SProxy :: SProxy "licenseInfo") licensee ∷ RelFile Sandboxed -licensee = dir "server" file "licensee" +licensee = dir_ (SProxy :: SProxy "server") file_ (SProxy :: SProxy "licensee") pdfInfo ∷ RelFile Sandboxed -pdfInfo = dir "service" dir "pdf" file "info" +pdfInfo = dir_ (SProxy :: SProxy "service") dir_ (SProxy :: SProxy "pdf") file_ (SProxy :: SProxy "info") generatePdf ∷ RelFile Sandboxed -generatePdf = dir "service" dir "pdf" file "generate" +generatePdf = dir_ (SProxy :: SProxy "service") dir_ (SProxy :: SProxy "pdf") file_ (SProxy :: SProxy "generate") + + diff --git a/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs b/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs index 5ce284c..908dcd5 100644 --- a/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs +++ b/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs @@ -32,14 +32,12 @@ import Data.Either (Either(..)) import Data.Foldable (foldMap) import Data.Functor.Coproduct (Coproduct, left, right, coproduct) import Data.HTTP.Method (Method(..)) -import Data.List as List import Data.Maybe (Maybe(..), maybe) import Data.Monoid (mempty) import Data.Path.Pathy (()) import Data.Path.Pathy as Pt import Data.String as Str import Data.Tuple (Tuple(..), snd) -import Data.URI as URI import Network.HTTP.Affjax as AX import Network.HTTP.Affjax.Request (RequestContent, toRequest) import Network.HTTP.AffjaxF as AXF @@ -51,6 +49,7 @@ import Quasar.Advanced.QuasarAF.Interpreter.Config (Config) import Quasar.Advanced.QuasarAF.Interpreter.Internal (mkGroupUrl) import Quasar.Advanced.Types as Qa import Quasar.ConfigF as CF +import Quasar.Data.URI as URI import Quasar.Error (QResponse) import Quasar.QuasarF.Interpreter.Affjax as QCI import Quasar.QuasarF.Interpreter.Internal (ask, defaultRequest, jsonResult, mkRequest, mkUrl, unitResult) @@ -121,14 +120,14 @@ evalQuasarAdvanced (PermissionInfo pid k) = do config ← ask url ← mkUrl (Right (Paths.permission Pt.file (Qa.runPermissionId pid))) - (URI.Query (List.singleton (Tuple "transitive" Nothing))) + (URI.QueryPairs [Tuple "transitive" Nothing]) map k $ mkAuthedRequest (jsonResult >>> map Qa.runPermission) $ _{ url = url } evalQuasarAdvanced (PermissionChildren pid isTransitive k) = do config ← ask url ← mkUrl - (Right (Paths.permission Pt.dir (Qa.runPermissionId pid) Pt.file "children")) + (Right (Paths.permission Pt.dir (Qa.runPermissionId pid) Paths.children )) (transitiveQuery isTransitive) map k $ mkAuthedRequest (jsonResult >>> map (map Qa.runPermission)) @@ -214,9 +213,9 @@ evalQuasarAdvanced (PDFInfo k) = do $ mkAuthedRequest (const (Right unit)) $ _{ url = url } -transitiveQuery ∷ Boolean → URI.Query +transitiveQuery ∷ Boolean → URI.QQuery transitiveQuery b = - if b then URI.Query (List.singleton (Tuple "transitive" Nothing)) else mempty + if b then URI.QueryPairs [Tuple "transitive" Nothing] else mempty mkAuthedRequest ∷ ∀ a r diff --git a/src/Quasar/Advanced/QuasarAF/Interpreter/Internal.purs b/src/Quasar/Advanced/QuasarAF/Interpreter/Internal.purs index 9f43fd2..a94f94a 100644 --- a/src/Quasar/Advanced/QuasarAF/Interpreter/Internal.purs +++ b/src/Quasar/Advanced/QuasarAF/Interpreter/Internal.purs @@ -24,7 +24,7 @@ import Data.Functor.Coproduct (Coproduct) import Data.Maybe (Maybe(..)) import Data.Path.Pathy (rootDir) import Data.String as String -import Data.URI as URI +import Quasar.Data.URI as URI import Network.HTTP.Affjax.Request (RequestContent) import Network.HTTP.AffjaxF as AXF import Quasar.Advanced.Paths as Paths @@ -38,7 +38,7 @@ type AXFP = AXF.AffjaxFP RequestContent String mkGroupUrl ∷ ∀ r . GroupPath - → URI.Query + → URI.QQuery → Free (Coproduct (CF.ConfigF (Config r)) AXFP) String mkGroupUrl (GroupPath gp) q = do url ← mkFSUrl Paths.group (Left gp) q diff --git a/src/Quasar/Advanced/Types.purs b/src/Quasar/Advanced/Types.purs index 7823d06..0d44f8f 100644 --- a/src/Quasar/Advanced/Types.purs +++ b/src/Quasar/Advanced/Types.purs @@ -11,6 +11,7 @@ import Data.Newtype as Newtype import Data.Path.Pathy (()) import Data.Path.Pathy as Pt import Data.String as Str +import Data.String.NonEmpty (NonEmptyString, fromString, toString) import Data.Traversable (traverse) import OIDC.Crypt.JSONWebKey (JSONWebKey) import OIDC.Crypt.Types (Issuer(..), ClientId(..)) @@ -159,47 +160,56 @@ instance decodeJsonAction ∷ DecodeJson Action where <*> (obj .? "accessType") <#> Action -newtype UserId = UserId String +newtype UserId = UserId NonEmptyString -runUserId ∷ UserId → String +runUserId ∷ UserId → NonEmptyString runUserId (UserId s) = s derive instance eqUserId ∷ Eq UserId derive instance ordUserId ∷ Ord UserId instance encodeJsonUserId ∷ EncodeJson UserId where - encodeJson = encodeJson <<< runUserId + encodeJson = encodeNEString <<< runUserId instance decodeJsonUserId ∷ DecodeJson UserId where - decodeJson = map UserId <<< decodeJson + decodeJson = map UserId <<< decodeNEString +encodeNEString :: NonEmptyString -> Json +encodeNEString = encodeJson <<< toString -newtype TokenId = TokenId String +decodeNEString :: Json -> Either String NonEmptyString +decodeNEString j = do + str <- decodeJson j + case fromString str of + Nothing -> Left "Expected string to be non empty" + Just a -> pure a -runTokenId ∷ TokenId → String +newtype TokenId = TokenId NonEmptyString + +runTokenId ∷ TokenId → NonEmptyString runTokenId (TokenId s) = s derive instance eqTokenId ∷ Eq TokenId derive instance ordTokenId ∷ Ord TokenId instance encodeJsonTokenId ∷ EncodeJson TokenId where - encodeJson = runTokenId >>> encodeJson + encodeJson = encodeNEString <<< runTokenId instance decodeJsonTokenId ∷ DecodeJson TokenId where - decodeJson = map TokenId <<< decodeJson + decodeJson = map TokenId <<< decodeNEString -newtype PermissionId = PermissionId String -runPermissionId ∷ PermissionId → String +newtype PermissionId = PermissionId NonEmptyString +runPermissionId ∷ PermissionId → NonEmptyString runPermissionId (PermissionId s) = s derive instance eqPermissionId ∷ Eq PermissionId derive instance ordPermissionId ∷ Ord PermissionId instance encodeJsonPermissionId ∷ EncodeJson PermissionId where - encodeJson = encodeJson <<< runPermissionId + encodeJson = encodeNEString <<< runPermissionId instance decodeJsonPermissionId ∷ DecodeJson PermissionId where - decodeJson = map PermissionId <<< decodeJson + decodeJson = map PermissionId <<< decodeNEString data GrantedTo @@ -234,11 +244,15 @@ instance decodeJsonGrantedTo ∷ DecodeJson GrantedTo where parseUserId ∷ String → Either String UserId parseUserId str = - Str.stripPrefix (Str.Pattern "user:") str # maybe (Left "Incorrect user") (pure <<< UserId) + Str.stripPrefix (Str.Pattern "user:") str + >>= fromString + # maybe (Left "Incorrect user") (pure <<< UserId) parseTokenId ∷ String → Either String TokenId parseTokenId str = - Str.stripPrefix (Str.Pattern "token:") str # maybe (Left "Incorrect token") (pure <<< TokenId) + Str.stripPrefix (Str.Pattern "token:") str + >>= fromString + # maybe (Left "Incorrect token") (pure <<< TokenId) parseGroup ∷ String → Either String GroupPath parseGroup string = @@ -325,7 +339,7 @@ data ShareableSubject instance encodeJsonShareableSubject ∷ EncodeJson ShareableSubject where encodeJson (UserSubject (UserId uid)) = - encodeJson $ "user:" <> uid + encodeJson $ "user:" <> toString uid encodeJson (GroupSubject gpt) = encodeJson $ printGroupPath gpt @@ -343,7 +357,7 @@ runShareRequest (ShareRequest r) = r instance encodeJsonShareRequest ∷ EncodeJson ShareRequest where encodeJson (ShareRequest obj) = - "subjects" := ((map (append "user:" <<< runUserId) obj.users) + "subjects" := ((map (append "user:" <<< toString <<< runUserId) obj.users) <> map (append "group:" <<< printGroupPath) obj.groups) ~> "actions" := (map Action $ obj.actions) ~> jsonEmptyObject diff --git a/src/Quasar/Data/URI.purs b/src/Quasar/Data/URI.purs new file mode 100644 index 0000000..63736af --- /dev/null +++ b/src/Quasar/Data/URI.purs @@ -0,0 +1,271 @@ +{- +Copyright 2017 SlamData, Inc. + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. +-} + +module Quasar.Data.URI + ( QHierarchicalPart + , QURIHost + , QQuery + , AbsPath + , RelPath' + , AnyPath + , QAuthority + , QAbsoluteURI + , qAbsoluteURI + , QRelativeRef + , qRelativeRef + , QURIRef + , qURIRef + , QURI + , opts + , regNameFromString + , portFromInt + , printScheme + , unsafeSchemaFromString + , unsafePortFromInt + , unsafeRegNameFromString + , module URI + ) where + +import Prelude + +import Data.Array (fromFoldable) +import Data.Bifunctor (bimap) +import Data.Bitraversable (bitraverse) +import Data.Either (Either(..), either) +import Data.List (List(..)) +import Data.Maybe (Maybe(..), maybe) +import Data.Path.Pathy (class SplitDirOrFile) +import Data.Path.Pathy (Abs, AbsPath, Name, viewDir, viewDirUnsandboxed, viewFile, viewFileUnsandboxed, Path, RelPath, Sandboxed, Unsandboxed, appendPath, parsePath, rootDir, runName, sandbox) as Py +import Data.Record.Builder as Builder +import Data.Tuple (Tuple(..)) +import Data.URI (PathAbsolute, PathRootless, RegName) +import Data.URI (URI(..), RelativePart(..), Authority(..), AbsoluteURI(..), HierarchicalPart(..), HierPath, Host(..), Path(..), Port, RelativeRef(..), URIRef, Fragment, Query, UserInfo) as URI +import Data.URI.AbsoluteURI (AbsoluteURIOptions) as URI +import Data.URI.AbsoluteURI (print, parser) as AbsoluteURI +import Data.URI.Common (URIPartParseError(..)) +import Data.URI.Extra.MultiHostPortPair (MultiHostPortPair) as URI +import Data.URI.Extra.MultiHostPortPair (print, parser) as MultiHostPortPair +import Data.URI.Extra.QueryPairs (QueryPairs(..), Key, Value) as URI +import Data.URI.Extra.QueryPairs (print, parse, keyToString, valueToString, keyFromString, valueFromString) as QueryPairs +import Data.URI.Extra.UserPassInfo (UserPassInfo(..)) as URI +import Data.URI.Extra.UserPassInfo (print, parse) as UserPassInfo +import Data.URI.Host.RegName (fromString, unsafeFromString) as RegName +import Data.URI.Path (Path) +import Data.URI.Path (print) as Path +import Data.URI.Path.Absolute (print, PathAbsolute(..)) as PathAbsolute +import Data.URI.Path.NoScheme (print, PathNoScheme(..)) as PathNoScheme +import Data.URI.Path.Rootless (print) as PathRootless +import Data.URI.Path.Segment (PathSegment, PathSegmentNZ, segmentFromString, unsafeSegmentNZFromString, unsafeSegmentNZNCFromString) +import Data.URI.Port (fromInt, unsafeFromInt) as Port +import Data.URI.RelativeRef (RelativeRefOptions) as URI +import Data.URI.RelativeRef (print, parser, RelPath) as RelativeRef +import Data.URI.Scheme (Scheme) as URI +import Data.URI.Scheme (unsafeFromString, print) as Scheme +import Data.URI.URI (URIOptions) as URI +import Data.URI.URIRef (URIRefOptions) as URI +import Data.URI.URIRef (print, parser) as URIRef +import Text.Parsing.Parser (Parser) +import Type.Row (class RowListNub, class RowToList) + +type AbsPath = Py.AbsPath Py.Sandboxed +type RelPath' = Py.RelPath Py.Unsandboxed +type AnyPath = Either AbsPath RelPath' +type QURIHost = URI.MultiHostPortPair URI.Host URI.Port +type QAuthority = URI.Authority URI.UserPassInfo QURIHost +type QQuery = URI.QueryPairs String String +type QHierarchicalPart = URI.HierarchicalPart URI.UserPassInfo QURIHost AbsPath AbsPath + +type QAbsoluteURI = URI.AbsoluteURI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery +type QAbsoluteURIOptions = URI.AbsoluteURIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery + +type QRelativeRef = URI.RelativeRef URI.UserPassInfo QURIHost AbsPath AnyPath QQuery URI.Fragment +type QRelativeRefOptions = URI.RelativeRefOptions URI.UserPassInfo QURIHost AbsPath AnyPath QQuery URI.Fragment + +type QURIRef = URI.URIRef URI.UserPassInfo QURIHost AbsPath AbsPath AnyPath QQuery URI.Fragment +type QURIRefOptions = URI.URIRefOptions URI.UserPassInfo QURIHost AbsPath AbsPath AnyPath QQuery URI.Fragment + +type QURI = URI.URI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment +type QURIOptions = URI.URIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment + +type PrintParse from = { print :: from → String, parser :: Parser String from } +qAbsoluteURI ∷ PrintParse QAbsoluteURI +qAbsoluteURI = { print: AbsoluteURI.print opts.absoluteURI, parser: AbsoluteURI.parser opts.absoluteURI } +qRelativeRef ∷ PrintParse QRelativeRef +qRelativeRef = { print: RelativeRef.print opts.relativeRef, parser: RelativeRef.parser opts.relativeRef } +qURIRef ∷ PrintParse QURIRef +qURIRef = { print: URIRef.print opts.uriRef, parser: URIRef.parser opts.uriRef } + +opts :: + { absoluteURI ∷ Record QAbsoluteURIOptions + , relativeRef ∷ Record QRelativeRefOptions + , uriRef ∷ Record QURIRefOptions + } +opts = + { absoluteURI: _common `union` _Path `union` _HierPath + , relativeRef: _common `union` _Path`union` _Fragment `union` _RelPath + , uriRef: _common `union` _HierPath `union` _Path `union` _Fragment `union` _RelPath + } + where + _common = _UserInfo `union` _Hosts `union` _Query + + _UserInfo = { parseUserInfo, printUserInfo } + _Hosts = { parseHosts, printHosts } + _Query = { parseQuery, printQuery } + _Path = { parsePath, printPath } + _HierPath = { parseHierPath, printHierPath } + _Fragment = { parseFragment, printFragment } + _RelPath = { parseRelPath, printRelPath } + + parseQuery :: URI.Query -> Either URIPartParseError QQuery + parseQuery = QueryPairs.parse (QueryPairs.keyToString >>> pure) (QueryPairs.valueToString >>> pure) + printQuery :: QQuery -> URI.Query + printQuery = QueryPairs.print QueryPairs.keyFromString QueryPairs.valueFromString + + parseUserInfo :: URI.UserInfo -> Either URIPartParseError URI.UserPassInfo + parseUserInfo = UserPassInfo.parse + printUserInfo :: URI.UserPassInfo -> URI.UserInfo + printUserInfo = UserPassInfo.print + + parseHosts :: Parser String QURIHost + parseHosts = MultiHostPortPair.parser pure pure + printHosts :: QURIHost -> String + printHosts = MultiHostPortPair.print id id + + parsePath :: Path -> Either URIPartParseError AbsPath + parsePath = parseAbsSandboxedPath <<< Path.print + printPath ∷ AbsPath → Path + printPath = bimap Py.viewDir Py.viewFile >>>case _ of + Left d -> + URI.Path + $ fromFoldable d + <#> Py.runName >>> segmentFromString + Right (Tuple d n) -> + URI.Path + $ (fromFoldable d <#> asSegment) <> [asSegment n] + + + parseHierPath :: Either PathAbsolute PathRootless -> Either URIPartParseError AbsPath + parseHierPath = parseAbsSandboxedPath <<< either PathAbsolute.print PathRootless.print + printHierPath ∷ AbsPath → Either PathAbsolute PathRootless + printHierPath = _printAbsPath >>> Left + + parseFragment :: URI.Fragment -> Either URIPartParseError URI.Fragment + parseFragment = Right + printFragment :: URI.Fragment -> URI.Fragment + printFragment = id + + parseRelPath :: RelativeRef.RelPath -> Either URIPartParseError AnyPath + parseRelPath = + bitraverse + (PathAbsolute.print >>> parseAbsSandboxedPath) + (PathNoScheme.print >>> parseRelUnsandboxedPath) + + + printRelPath :: AnyPath -> RelativeRef.RelPath + printRelPath = + bimap + _printAbsPath + _printRelPath + + _printAbsPath :: AbsPath → PathAbsolute + _printAbsPath = bimap Py.viewDir Py.viewFile >>> case _ of + Left Nil -> PathAbsolute.PathAbsolute Nothing + Left (Cons head tail) -> PathAbsolute.PathAbsolute $ Just + $ Tuple (asSegmentNZ head) + $ (asSegment <$> fromFoldable tail) + Right (Tuple d n) -> case d of + Nil -> PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ n) [] + Cons head tail -> PathAbsolute.PathAbsolute + $ Just + $ Tuple (asSegmentNZ head) + $ (asSegment <$> fromFoldable tail) <> [ asSegment n ] + + _printRelPath :: RelPath' → PathNoScheme.PathNoScheme + _printRelPath = bimap Py.viewDirUnsandboxed Py.viewFileUnsandboxed >>> case _ of + Left Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString "./") [] + Left (Cons head tail) -> + PathNoScheme.PathNoScheme + $ Tuple (unsafeSegmentNZNCFromString $ maybe "../" Py.runName head) + $ (segmentFromString <<< maybe "../" Py.runName <$> fromFoldable tail) + Right (Tuple d n) -> case d of + Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ Py.runName n) [] + Cons head tail -> PathNoScheme.PathNoScheme + $ Tuple (unsafeSegmentNZNCFromString $ maybe "../" Py.runName head) + $ (segmentFromString <<< maybe "../" Py.runName <$> fromFoldable tail) <> [ asSegment n ] + + + parseAbsSandboxedPath :: String -> Either URIPartParseError AbsPath + parseAbsSandboxedPath = + Py.parsePath + (const Nothing) + (map Left <<< sandbox) + (const Nothing) + (map Right <<< sandbox) + (const Nothing) + >>> maybe (Left $ URIPartParseError "got invalid path") Right + + parseRelUnsandboxedPath :: String -> Either URIPartParseError RelPath' + parseRelUnsandboxedPath = + Py.parsePath + (Just <<< Left) + (const Nothing) + (Just <<< Right) + (const Nothing) + (const Nothing) + >>> maybe (Left $ URIPartParseError "got invalid path") Right + + sandbox + :: forall b s + . SplitDirOrFile b + => Py.Path Py.Abs b s + -> Maybe (Py.Path Py.Abs b Py.Sandboxed) + sandbox p = Py.appendPath Py.rootDir <$> Py.sandbox Py.rootDir p + + +printScheme :: URI.Scheme -> String +printScheme = Scheme.print + +unsafeSchemaFromString :: String -> URI.Scheme +unsafeSchemaFromString = Scheme.unsafeFromString + +regNameFromString :: String -> Maybe RegName +regNameFromString = RegName.fromString + +unsafeRegNameFromString :: String -> RegName +unsafeRegNameFromString = RegName.unsafeFromString + +unsafePortFromInt :: Int -> URI.Port +unsafePortFromInt = Port.unsafeFromInt + +portFromInt :: Int -> Maybe URI.Port +portFromInt = Port.fromInt + +-- Union which rejects duplicates +union + :: forall r1 r2 r3 r3l + . Union r1 r2 r3 + => RowToList r3 r3l + => RowListNub r3l r3l + => { | r1 } + -> { | r2 } + -> { | r3 } +union r1 r2 = Builder.build (Builder.merge r2) r1 + +asSegmentNZ :: forall a. Py.Name a -> PathSegmentNZ +asSegmentNZ = Py.runName >>> unsafeSegmentNZFromString + +asSegment :: forall a. Py.Name a -> PathSegment +asSegment = Py.runName >>> segmentFromString diff --git a/src/Quasar/FS/Mount.purs b/src/Quasar/FS/Mount.purs index 44c8da5..96a8ae8 100644 --- a/src/Quasar/FS/Mount.purs +++ b/src/Quasar/FS/Mount.purs @@ -24,10 +24,11 @@ import Data.Const (Const(..)) import Data.Either (Either(..)) import Data.Eq (class Eq1, eq1) import Data.Identity (Identity(..)) -import Data.Maybe (Maybe) +import Data.Maybe (Maybe, maybe) import Data.Newtype (unwrap) import Data.Ord (class Ord1, compare1) -import Data.Path.Pathy (DirName, FileName, dir, file, pathName, ()) +import Data.Path.Pathy (Dir, File, Name, dir, file, pathName, ()) +import Data.String.NonEmpty (fromString) import Data.TacitString as TS import Quasar.Types (AnyPath, DirPath, FilePath) @@ -116,7 +117,8 @@ fromJSON ∷ DirPath → Json → Either String Mount fromJSON parent = decodeJson >=> \obj → do mount ← obj .? "mount" typ ← obj .? "type" - name ← obj .? "name" + name' ← obj .? "name" + name <- maybe (Left "empty name") Right $ fromString name' let err :: forall a. Either String a err = Left $ "Unexpected type '" <> typ <> "' for mount '" <> mount <> "'" @@ -143,7 +145,7 @@ foldPath onDir onPath = overPath (onDir >>> Const) (onPath >>> Const) >>> unwrap getPath ∷ Mount → AnyPath getPath = foldPath Left Right -getName ∷ Mount → Either (Maybe DirName) FileName +getName ∷ Mount → Either (Maybe (Name Dir)) (Name File) getName = getPath >>> pathName typeFromName ∷ String → MountType diff --git a/src/Quasar/FS/Resource.purs b/src/Quasar/FS/Resource.purs index 79bd793..95fbc9a 100644 --- a/src/Quasar/FS/Resource.purs +++ b/src/Quasar/FS/Resource.purs @@ -21,8 +21,9 @@ import Prelude import Control.Alt ((<|>)) import Data.Argonaut (Json, decodeJson, (.?)) import Data.Either (Either(..)) -import Data.Maybe (Maybe) -import Data.Path.Pathy (DirName, FileName, dir, file, pathName, ()) +import Data.Maybe (Maybe, maybe) +import Data.Path.Pathy (Dir, File, Name, dir, file, pathName, ()) +import Data.String.NonEmpty (fromString) import Quasar.FS.Mount as Mount import Quasar.Types (AnyPath, FilePath, DirPath) @@ -44,7 +45,8 @@ fromJSON parent json = Mount <$> Mount.fromJSON parent json <|> do obj ← decodeJson json - name ← obj .? "name" + name' ← obj .? "name" + name <- maybe (Left "empty name") Right $ fromString name' obj .? "type" >>= case _ of "directory" → Right $ Directory (parent dir name) "file" → Right $ File (parent file name) @@ -55,5 +57,5 @@ getPath (File p) = Right p getPath (Directory p) = Left p getPath (Mount m) = Mount.getPath m -getName ∷ QResource → Either (Maybe DirName) FileName +getName ∷ QResource → Either (Maybe (Name Dir)) (Name File) getName = pathName <<< getPath diff --git a/src/Quasar/Internal.purs b/src/Quasar/Internal.purs new file mode 100644 index 0000000..fc68da7 --- /dev/null +++ b/src/Quasar/Internal.purs @@ -0,0 +1,24 @@ +module Quasar.Internal where + +import Data.Path.Pathy (RelDir, RelFile, Sandboxed, file, dir) +import Data.String.NonEmpty (NonEmptyString) +import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) +import Type.Data.Boolean (False) +import Type.Data.Symbol (class Equals) +import Unsafe.Coerce (unsafeCoerce) + +class IsSymbolNonEmpty sym where + reflectNonEmpty :: SProxy sym -> NonEmptyString + +instance isSymbolNonEmpty :: (IsSymbol s, Equals s "" False) => IsSymbolNonEmpty s where + reflectNonEmpty _ = asNonEmpty (reflectSymbol (SProxy :: SProxy s)) + where + asNonEmpty :: String -> NonEmptyString + asNonEmpty = unsafeCoerce + + +file_ :: forall s. IsSymbolNonEmpty s => SProxy s → RelFile Sandboxed +file_ x = file (reflectNonEmpty x) + +dir_ :: forall s. IsSymbolNonEmpty s => SProxy s → RelDir Sandboxed +dir_ x = dir (reflectNonEmpty x) diff --git a/src/Quasar/Mount/Common.purs b/src/Quasar/Mount/Common.purs index f22fc4e..94732f4 100644 --- a/src/Quasar/Mount/Common.purs +++ b/src/Quasar/Mount/Common.purs @@ -18,22 +18,12 @@ module Quasar.Mount.Common where import Prelude -import Data.Either (Either(..)) -import Data.Maybe (Maybe(..)) +import Data.Lens (view) +import Data.Maybe (Maybe(..), fromMaybe) import Data.Newtype (class Newtype) -import Data.String as Str -import Data.Tuple (Tuple) -import Data.URI as URI - -type Host = Tuple URI.Host (Maybe URI.Port) - -extractHost ∷ Maybe URI.Authority → Either String Host -extractHost (Just (URI.Authority _ hs)) = - case hs of - [h] → Right h - [] → Left "No host specified" - _ → Left "Multiple hosts specified" -extractHost _ = Left "No host specified" +import Quasar.Data.URI as URI +import Data.URI.Authority (_userInfo) +import Data.URI.Extra.UserPassInfo (UserPassInfo(..)) newtype Credentials = Credentials { user ∷ String, password ∷ String } @@ -45,21 +35,12 @@ instance showCredentials ∷ Show Credentials where show (Credentials { user, password }) = "(Credentials { user: " <> show user <> ", password: " <> show password <> " })" -combineCredentials ∷ Credentials → URI.UserInfo -combineCredentials (Credentials { user, password }) - | Str.null password = URI.UserInfo user - | otherwise = URI.UserInfo (user <> ":" <> password) +combineCredentials ∷ Credentials → UserPassInfo +combineCredentials (Credentials { user, password }) = UserPassInfo { user, password: Just password } -extractCredentials ∷ Maybe URI.Authority → Maybe Credentials -extractCredentials auth = do - URI.UserInfo userInfo ← (\(URI.Authority mui _) → mui) =<< auth - pure $ Credentials $ - case Str.indexOf (Str.Pattern ":") userInfo of - Nothing → - { user: userInfo - , password: "" - } - Just ix → - { user: Str.take ix userInfo - , password: Str.drop (ix + 1) userInfo - } +extractCredentials ∷ ∀ hosts. Maybe (URI.Authority UserPassInfo hosts) → Maybe Credentials +extractCredentials mbAuth = + let + mbUI = mbAuth >>= view _userInfo + in + mbUI <#> (\(UserPassInfo u) -> Credentials u{ password = fromMaybe "" u.password}) diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index 8407bbe..0ed9787 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -24,47 +24,73 @@ import Prelude import Control.Monad.Gen (class MonadGen) import Control.Monad.Gen as Gen import Control.Monad.Gen.Common as GenC -import Control.Monad.Rec.Class (class MonadRec) +import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM) import Data.Char.Gen as CG import Data.Either (Either(..)) +import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) import Data.Path.Pathy.Gen (genAbsDirPath, genAbsFilePath) as PGen import Data.String as S import Data.String.Gen as SG -import Data.Tuple (Tuple(..)) -import Data.URI as URI -import Quasar.Mount.Common (Credentials(..)) -import Quasar.Mount.MongoDB as MDB +import Data.String.NonEmpty (NonEmptyString, cons) +import Data.These (These(..)) +import Data.URI.Host.IPv4Address (fromInts) as IPv4Address +import Quasar.Data.URI as URI import Quasar.Types (AnyPath) genAlphaNumericString ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m String -genAlphaNumericString = SG.genString $ Gen.oneOf $ CG.genDigitChar :| [CG.genAlpha] +genAlphaNumericString = SG.genString genAlphaNumericChar + +genAlphaNumericNEString ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m NonEmptyString +genAlphaNumericNEString = cons <$> genAlphaNumericChar <*> SG.genString genAlphaNumericChar + +genAlphaNumericChar ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m Char +genAlphaNumericChar = Gen.oneOf $ CG.genDigitChar :| [CG.genAlpha] genHostURI ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.Host genHostURI = Gen.oneOf $ genIPv4 :| [genName] where - genIPv4 = do + genIPv4 = filtered do a ← Gen.chooseInt 1 254 b ← Gen.chooseInt 1 254 c ← Gen.chooseInt 1 254 d ← Gen.chooseInt 1 254 - pure $ URI.IPv4Address $ S.joinWith "." $ show <$> [a, b, c, d] - genName = do + pure $ URI.IPv4Address <$> IPv4Address.fromInts a b c d + genName = URI.NameAddress <$> genRegName + genRegName = filtered do head ← S.singleton <$> CG.genAlpha tail ← genAlphaNumericString - pure $ URI.NameAddress $ head <> tail + pure $ URI.regNameFromString $ head <> tail + +genPort ∷ ∀ m. MonadRec m => MonadGen m ⇒ m URI.Port +genPort = filtered $ URI.portFromInt <$> Gen.chooseInt 50000 65535 -genPort ∷ ∀ m. MonadGen m ⇒ m URI.Port -genPort = URI.Port <$> Gen.chooseInt 50000 65535 +genHost ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.QURIHost +genHost = Gen.unfoldable $ genThese genHostURI genPort -genHost ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m MDB.Host -genHost = Tuple <$> genHostURI <*> GenC.genMaybe genPort +genThese ∷ ∀ m a b. MonadGen m ⇒ MonadRec m ⇒ m a -> m b -> m (These a b) +genThese ma mb = filtered do + a' <- GenC.genMaybe ma + b' <- GenC.genMaybe mb + pure case a', b' of + Just a, Just b -> Just $ Both a b + Just a, Nothing -> Just $ This a + Nothing, Just b -> Just $ That b + Nothing, Nothing -> Nothing -genCredentials ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m Credentials +genCredentials ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.UserPassInfo genCredentials = - Credentials <$> ({ user: _, password: _ } + URI.UserPassInfo <$> ({ user: _, password: _ } <$> genAlphaNumericString - <*> Gen.choose (pure "") genAlphaNumericString) + <*> Gen.choose (pure Nothing) (Just <$> genAlphaNumericString)) genAnyPath ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m AnyPath genAnyPath = Gen.oneOf $ (Left <$> PGen.genAbsDirPath) :| [Right <$> PGen.genAbsFilePath] + +filtered :: forall m a. MonadRec m => MonadGen m => m (Maybe a) -> m a +filtered gen = tailRecM go unit + where + go :: Unit -> m (Step Unit a) + go _ = gen <#> \a -> case a of + Nothing -> Loop unit + Just a -> Done a diff --git a/src/Quasar/Mount/Couchbase.purs b/src/Quasar/Mount/Couchbase.purs index 715ed98..309bcdf 100644 --- a/src/Quasar/Mount/Couchbase.purs +++ b/src/Quasar/Mount/Couchbase.purs @@ -20,7 +20,6 @@ module Quasar.Mount.Couchbase , fromJSON , toURI , fromURI - , module Exports ) where import Prelude @@ -28,23 +27,21 @@ import Prelude import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Bifunctor (lmap) import Data.Either (Either(..)) -import Data.List as L import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Newtype (un) import Data.Number as Num import Data.Path.Pathy (()) import Data.Path.Pathy as P import Data.StrMap as SM +import Data.String.NonEmpty (NonEmptyString) import Data.Time.Duration (Seconds(..)) import Data.Tuple (Tuple(..)) -import Data.URI as URI -import Data.URI.AbsoluteURI as AbsoluteURI -import Quasar.Mount.Common (Host) as Exports -import Quasar.Mount.Common (Host, extractHost) +import Quasar.Data.URI as URI +import Text.Parsing.Parser (runParser) type Config = - { host ∷ Host - , bucketName ∷ String + { host ∷ URI.QURIHost + , bucketName ∷ Maybe NonEmptyString , password ∷ String , docTypeKey ∷ String , queryTimeout ∷ Maybe Seconds @@ -52,43 +49,54 @@ type Config = toJSON ∷ Config → Json toJSON config = - let uri = AbsoluteURI.print (toURI config) + let uri = URI.qAbsoluteURI.print (toURI config) in "couchbase" := ("connectionUri" := uri ~> jsonEmptyObject) ~> jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON = fromURI - <=< lmap show <<< AbsoluteURI.parse + <=< lmap show <<< flip runParser URI.qAbsoluteURI.parser <=< (_ .? "connectionUri") <=< (_ .? "couchbase") <=< decodeJson -toURI ∷ Config → URI.AbsoluteURI +toURI ∷ Config → URI.QAbsoluteURI toURI { host, bucketName, password, docTypeKey, queryTimeout } = URI.AbsoluteURI - (Just uriScheme) - (URI.HierarchicalPart - (Just (URI.Authority Nothing (pure host))) - (Just (Right (P.rootDir P.file bucketName)))) - (Just (URI.Query props)) + uriScheme + hierarchicalPart + (Just (URI.QueryPairs props)) where - props ∷ L.List (Tuple String (Maybe String)) - props = L.Nil - <> pure (Tuple "password" (Just password)) - <> pure (Tuple "docTypeKey" (Just docTypeKey)) - <> maybe L.Nil (pure <<< Tuple "queryTimeoutSeconds" <<< Just <<< show <<< un Seconds) queryTimeout + hierarchicalPart :: URI.QHierarchicalPart + hierarchicalPart = + URI.HierarchicalPartAuth + authority + (case bucketName of + Nothing -> Just $ Left P.rootDir + Just n -> Just $ Right $ P.rootDir P.file n + ) -fromURI ∷ URI.AbsoluteURI → Either String Config -fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPart auth path) query) = do - unless (scheme == Just uriScheme) $ Left "Expected 'couchbase' URL scheme" - host ← extractHost auth + authority :: URI.QAuthority + authority = URI.Authority Nothing host + + props ∷ Array (Tuple String (Maybe String)) + props = + [ Tuple "password" (Just password) + , Tuple "docTypeKey" (Just docTypeKey) + ] <> maybe [] (pure <<< Tuple "queryTimeoutSeconds" <<< Just <<< show <<< un Seconds) queryTimeout + +fromURI ∷ URI.QAbsoluteURI → Either String Config +fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartNoAuth path) query) = + Left "Expected 'auth' part in URI" +fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ host) path) query) = do + unless (scheme == uriScheme) $ Left "Expected 'couchbase' URL scheme" bucketName ← case path of Nothing → Left "Path is missing from URL" Just (Left p) - | p == P.rootDir → pure "" + | p == P.rootDir → pure Nothing | otherwise → Left "Expected a file path" - Just (Right p) → pure $ P.runFileName $ P.fileName p - let props = maybe SM.empty (\(URI.Query qs) → SM.fromFoldable qs) query + Just (Right p) → pure $ Just $ un P.Name $ P.fileName p + let props = maybe SM.empty (\(URI.QueryPairs qs) → SM.fromFoldable qs) query pure { host , bucketName @@ -98,4 +106,5 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPart auth path) query) = do } uriScheme ∷ URI.Scheme -uriScheme = URI.Scheme "couchbase" +uriScheme = URI.unsafeSchemaFromString "couchbase" + diff --git a/src/Quasar/Mount/Couchbase/Gen.purs b/src/Quasar/Mount/Couchbase/Gen.purs index 3141d78..02ca978 100644 --- a/src/Quasar/Mount/Couchbase/Gen.purs +++ b/src/Quasar/Mount/Couchbase/Gen.purs @@ -22,15 +22,16 @@ import Control.Monad.Gen (class MonadGen) import Control.Monad.Gen as Gen import Control.Monad.Gen.Common as GenC import Control.Monad.Rec.Class (class MonadRec) +import Data.Maybe (Maybe(..)) import Data.Time.Duration.Gen (genSeconds) -import Quasar.Mount.Common.Gen (genAlphaNumericString, genHost) +import Quasar.Mount.Common.Gen (genAlphaNumericNEString, genAlphaNumericString, genHost) import Quasar.Mount.Couchbase as CB genConfig ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m CB.Config genConfig = { host: _, bucketName: _, password: _, docTypeKey: _, queryTimeout: _ } <$> genHost - <*> Gen.choose (pure "") genAlphaNumericString + <*> Gen.choose (pure Nothing) (Just <$> genAlphaNumericNEString) <*> genAlphaNumericString <*> genAlphaNumericString <*> GenC.genMaybe genSeconds diff --git a/src/Quasar/Mount/MarkLogic.purs b/src/Quasar/Mount/MarkLogic.purs index 2c9215b..82c330c 100644 --- a/src/Quasar/Mount/MarkLogic.purs +++ b/src/Quasar/Mount/MarkLogic.purs @@ -21,7 +21,6 @@ module Quasar.Mount.MarkLogic , fromJSON , toURI , fromURI - , module Exports ) where import Prelude @@ -29,20 +28,17 @@ import Prelude import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Bifunctor (lmap) import Data.Either (Either(..)) -import Data.List as L import Data.Maybe (Maybe(..), maybe) import Data.StrMap as SM import Data.Tuple (Tuple(..)) -import Data.URI as URI -import Data.URI.AbsoluteURI as AbsoluteURI -import Quasar.Mount.Common (Host, Credentials(..)) as Exports -import Quasar.Mount.Common (Host, Credentials, combineCredentials, extractCredentials, extractHost) +import Quasar.Data.URI as URI import Quasar.Types (AnyPath) +import Text.Parsing.Parser (runParser) type Config = - { host ∷ Host + { host ∷ URI.QURIHost , path ∷ Maybe AnyPath - , credentials ∷ Maybe Credentials + , credentials ∷ Maybe URI.UserPassInfo , format ∷ Format } @@ -60,39 +56,36 @@ instance showFormat ∷ Show Format where toJSON ∷ Config → Json toJSON config = - let uri = AbsoluteURI.print (toURI config) + let uri = URI.qAbsoluteURI.print (toURI config) in "marklogic" := ("connectionUri" := uri ~> jsonEmptyObject) ~> jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON = fromURI - <=< lmap show <<< AbsoluteURI.parse + <=< lmap show <<< flip runParser URI.qAbsoluteURI.parser <=< (_ .? "connectionUri") <=< (_ .? "marklogic") <=< decodeJson -toURI ∷ Config → URI.AbsoluteURI +toURI ∷ Config → URI.QAbsoluteURI toURI { host, path, credentials, format } = URI.AbsoluteURI - (Just uriScheme) - (URI.HierarchicalPart (Just (URI.Authority (combineCredentials <$> credentials) (pure host))) path) - (Just (URI.Query props)) + uriScheme + (URI.HierarchicalPartAuth (URI.Authority credentials host) path) + (Just (URI.QueryPairs [ (Tuple "format" (Just formatStr)) ])) where - props ∷ L.List (Tuple String (Maybe String)) - props = L.singleton (Tuple "format" (Just formatStr)) - formatStr ∷ String formatStr = case format of JSON → "json" XML → "xml" -fromURI ∷ URI.AbsoluteURI → Either String Config -fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPart auth path) query) = do - unless (scheme == Just uriScheme) $ Left "Expected 'xcc' URL scheme" - host ← extractHost auth +fromURI ∷ URI.QAbsoluteURI → Either String Config +fromURI (URI.AbsoluteURI _ (URI.HierarchicalPartNoAuth _) _) = do + Left "Expected 'auth' part in URI" +fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority credentials host) path) query) = do + unless (scheme == uriScheme) $ Left "Expected 'xcc' URL scheme" let - credentials = extractCredentials auth - props = maybe SM.empty (\(URI.Query qs) → SM.fromFoldable qs) query + props = maybe SM.empty (\(URI.QueryPairs qs) → SM.fromFoldable qs) query format ← case join $ SM.lookup "format" props of Nothing → pure XML Just "xml" → pure XML @@ -101,4 +94,4 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPart auth path) query) = do pure { host, path, credentials, format} uriScheme ∷ URI.Scheme -uriScheme = URI.Scheme "xcc" +uriScheme = URI.unsafeSchemaFromString "xcc" diff --git a/src/Quasar/Mount/Mimir.purs b/src/Quasar/Mount/Mimir.purs index c81029a..3240ade 100644 --- a/src/Quasar/Mount/Mimir.purs +++ b/src/Quasar/Mount/Mimir.purs @@ -19,22 +19,22 @@ module Quasar.Mount.Mimir , toJSON , fromJSON , parseDirPath - , module Exports ) where import Prelude -import Data.Path.Pathy as P + import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Either (Either(..)) import Data.Maybe (Maybe, maybe) -import Data.Path.Pathy (Abs, Dir, Path, Sandboxed, Unsandboxed, ()) -import Quasar.Mount.Common (Host) as Exports +import Data.Path.Pathy (class SplitDirOrFile, Abs, Dir, Path, Sandboxed, Unsandboxed, ()) +import Data.Path.Pathy as P type Config = Path Abs Dir Sandboxed sandbox ∷ forall a - . Path Abs a Unsandboxed + . SplitDirOrFile a + ⇒ Path Abs a Unsandboxed → Maybe (Path Abs a Sandboxed) sandbox = map (P.rootDir _) <<< P.sandbox P.rootDir diff --git a/src/Quasar/Mount/MongoDB.purs b/src/Quasar/Mount/MongoDB.purs index 86110ae..12a2431 100644 --- a/src/Quasar/Mount/MongoDB.purs +++ b/src/Quasar/Mount/MongoDB.purs @@ -21,29 +21,24 @@ module Quasar.Mount.MongoDB , fromJSON , toURI , fromURI - , module Exports ) where import Prelude import Control.Alt ((<|>)) import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) -import Data.Array as Arr import Data.Bifunctor (lmap) import Data.Either (Either(..)) import Data.Foldable (null) import Data.Maybe (Maybe(..), maybe) import Data.Newtype (class Newtype, unwrap) -import Data.NonEmpty (NonEmpty(..), oneOf) import Data.Path.Pathy as P import Data.StrMap as SM -import Data.URI as URI -import Data.URI.AbsoluteURI as AbsoluteURI -import Quasar.Mount.Common (Host, Credentials(..)) as Exports -import Quasar.Mount.Common (Host, Credentials, combineCredentials, extractCredentials) +import Quasar.Data.URI as URI import Quasar.Types (AnyPath) +import Text.Parsing.Parser (runParser) -newtype Auth = Auth { path ∷ AnyPath, credentials ∷ Credentials } +newtype Auth = Auth { path ∷ AnyPath, credentials ∷ URI.UserPassInfo } derive instance newtypeAuth ∷ Newtype Auth _ derive instance eqAuth ∷ Eq Auth @@ -54,59 +49,53 @@ instance showAuth ∷ Show Auth where "(Auth { path: " <> show path <> ", credentials: " <> show credentials <> " })" type Config = - { hosts ∷ NonEmpty Array Host + { hosts ∷ URI.QURIHost + -- { hosts ∷ NonEmpty Array Host , auth ∷ Maybe Auth , props ∷ SM.StrMap (Maybe String) } toJSON ∷ Config → Json toJSON config = - let uri = AbsoluteURI.print (toURI config) + let uri = URI.qAbsoluteURI.print (toURI config) in "mongodb" := ("connectionUri" := uri ~> jsonEmptyObject) ~> jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON = fromURI - <=< lmap show <<< AbsoluteURI.parse + <=< lmap show <<< flip runParser URI.qAbsoluteURI.parser <=< (_ .? "connectionUri") <=< (_ .? "mongodb") <=< decodeJson -toURI ∷ Config → URI.AbsoluteURI +toURI ∷ Config → URI.QAbsoluteURI toURI { hosts, auth, props } = URI.AbsoluteURI - (Just uriScheme) - (URI.HierarchicalPart - (Just - (URI.Authority - (combineCredentials <<< _.credentials <<< unwrap <$> auth) - (oneOf hosts))) + uriScheme + (URI.HierarchicalPartAuth + (URI.Authority + (_.credentials <<< unwrap <$> auth) + hosts) (map (_.path <<< unwrap) auth <|> Just (Left P.rootDir))) (if null props then Nothing - else Just (URI.Query (SM.toUnfoldable props))) + else Just (URI.QueryPairs (SM.toUnfoldable props))) -fromURI ∷ URI.AbsoluteURI → Either String Config -fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPart auth path) query) = do - unless (scheme == Just uriScheme) $ Left "Expected 'mongodb' URL scheme" - hosts ← extractHosts auth - auth' ← case extractCredentials auth, path of - Just credentials, Just p → pure $ Just (Auth { path: p, credentials }) +fromURI ∷ URI.QAbsoluteURI → Either String Config +fromURI (URI.AbsoluteURI _ (URI.HierarchicalPartNoAuth _) _) = do + Left "Expected 'auth' part in URI" +fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority credentials hosts) path) query) = do + unless (scheme == uriScheme) $ Left "Expected 'mongodb' URL scheme" + auth' ← case credentials, path of + Just c, Just p → pure $ Just (Auth { path: p, credentials: c }) Nothing, Nothing → pure $ Nothing Just _, Nothing → Left "User credentials were specified, but no auth database" Nothing, Just p | p /= Left P.rootDir → Left "An auth database was specified, but no user credentials" | otherwise → pure $ Nothing - let props = maybe SM.empty (\(URI.Query qs) → SM.fromFoldable qs) query + let props = maybe SM.empty (\(URI.QueryPairs qs) → SM.fromFoldable qs) query pure { hosts, auth: auth', props } uriScheme ∷ URI.Scheme -uriScheme = URI.Scheme "mongodb" - -extractHosts ∷ Maybe URI.Authority → Either String (NonEmpty Array Host) -extractHosts = maybe err Right <<< (toNonEmpty <=< map getHosts) - where - getHosts (URI.Authority _ hs) = hs - toNonEmpty hs = NonEmpty <$> Arr.head hs <*> Arr.tail hs - err = Left "Host list must not be empty" +uriScheme = URI.unsafeSchemaFromString "mongodb" diff --git a/src/Quasar/Mount/MongoDB/Gen.purs b/src/Quasar/Mount/MongoDB/Gen.purs index a0543de..7c7b186 100644 --- a/src/Quasar/Mount/MongoDB/Gen.purs +++ b/src/Quasar/Mount/MongoDB/Gen.purs @@ -28,7 +28,7 @@ import Quasar.Mount.MongoDB as MDB genConfig ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m MDB.Config genConfig = { hosts: _, auth: _, props: _ } - <$> GenC.genNonEmpty genHost + <$> genHost <*> GenC.genMaybe genAuth <*> SMG.genStrMap genAlphaNumericString (GenC.genMaybe genAlphaNumericString) diff --git a/src/Quasar/Mount/SparkHDFS.purs b/src/Quasar/Mount/SparkHDFS.purs index 2be9cfb..d8670fc 100644 --- a/src/Quasar/Mount/SparkHDFS.purs +++ b/src/Quasar/Mount/SparkHDFS.purs @@ -20,7 +20,6 @@ module Quasar.Mount.SparkHDFS , fromJSON , toURI , fromURI - , module Exports ) where import Prelude @@ -29,56 +28,54 @@ import Data.Argonaut (Json, (.?), (:=), (~>)) import Data.Argonaut as J import Data.Bifunctor (lmap) import Data.Either (Either(..)) -import Data.List as L import Data.Maybe (Maybe(..), maybe) +import Data.Path.Pathy (parseAbsDir, printPath, rootDir, sandbox, ()) import Data.StrMap as SM import Data.Tuple (Tuple(..)) -import Data.URI as URI -import Data.URI.AbsoluteURI as AbsoluteURI -import Data.URI.Path (printPath, parseURIPathAbs) import Global (encodeURIComponent, decodeURIComponent) -import Quasar.Mount.Common (Host) as Exports -import Quasar.Mount.Common (Host, extractHost) +import Quasar.Data.URI as URI import Quasar.Types (DirPath) -import Text.Parsing.StringParser (runParser) +import Text.Parsing.Parser (runParser) type Config = - { sparkHost ∷ Host - , hdfsHost ∷ Host + { sparkHost ∷ URI.QURIHost + , hdfsHost ∷ URI.QURIHost , path ∷ DirPath , props ∷ SM.StrMap (Maybe String) } toJSON ∷ Config → Json toJSON config = - let uri = AbsoluteURI.print (toURI config) + let uri = URI.qAbsoluteURI.print (toURI config) in "spark-hdfs" := ("connectionUri" := uri ~> J.jsonEmptyObject) ~> J.jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON = fromURI - <=< lmap show <<< AbsoluteURI.parse + <=< lmap show <<< flip runParser URI.qAbsoluteURI.parser <=< (_ .? "connectionUri") <=< (_ .? "spark-hdfs") <=< J.decodeJson -toURI ∷ Config → URI.AbsoluteURI -toURI cfg = mkURI sparkURIScheme cfg.sparkHost (Just (URI.Query $ requiredProps <> optionalProps)) +toURI ∷ Config → URI.QAbsoluteURI +toURI cfg = + mkURI sparkURIScheme cfg.sparkHost (Just (URI.QueryPairs $ requiredProps <> optionalProps)) where - requiredProps ∷ L.List (Tuple String (Maybe String)) - requiredProps = L.fromFoldable - [ Tuple "hdfsUrl" $ Just $ encodeURIComponent $ AbsoluteURI.print $ mkURI hdfsURIScheme cfg.hdfsHost Nothing - , Tuple "rootPath" $ Just $ printPath (Left cfg.path) + requiredProps ∷ Array (Tuple String (Maybe String)) + requiredProps = + [ Tuple "hdfsUrl" $ Just $ encodeURIComponent $ URI.qAbsoluteURI.print $ mkURI hdfsURIScheme cfg.hdfsHost Nothing + , Tuple "rootPath" $ Just $ printPath cfg.path ] - optionalProps ∷ L.List (Tuple String (Maybe String)) + optionalProps ∷ Array (Tuple String (Maybe String)) optionalProps = SM.toUnfoldable cfg.props -fromURI ∷ URI.AbsoluteURI → Either String Config -fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPart auth _) query) = do - unless (scheme == Just sparkURIScheme) $ Left "Expected `spark` URL scheme" - sparkHost ← extractHost auth - let props = maybe SM.empty (\(URI.Query qs) → SM.fromFoldable qs) query +fromURI ∷ URI.QAbsoluteURI → Either String Config +fromURI (URI.AbsoluteURI _ (URI.HierarchicalPartNoAuth _) _) = do + Left "Expected 'auth' part in URI" +fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ sparkHost) _) query) = do + unless (scheme == sparkURIScheme) $ Left "Expected `spark` URL scheme" + let props = maybe SM.empty (\(URI.QueryPairs qs) → SM.fromFoldable qs) query Tuple hdfsHost props' ← case SM.pop "hdfsUrl" props of Just (Tuple (Just value) rest) → do @@ -88,31 +85,32 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPart auth _) query) = do Tuple path props'' ← case SM.pop "rootPath" props' of Just (Tuple (Just value) rest) → do - value' ← lmap show $ runParser parseURIPathAbs value - dirPath ← case value' of - Left dp → pure dp - Right _ → Left "Expected `rootPath` to be a directory path" + dirPath ← case parseAbsDir value >>= sandbox rootDir of + Just dp → pure $ rootDir dp + Nothing → Left "Expected `rootPath` to be a directory path" pure (Tuple dirPath rest) _ → Left "Expected `rootPath` query parameter" pure { sparkHost, hdfsHost, path, props: props'' } -mkURI ∷ URI.Scheme → Host → Maybe URI.Query → URI.AbsoluteURI +mkURI :: URI.Scheme -> URI.QURIHost -> Maybe URI.QQuery -> URI.QAbsoluteURI mkURI scheme host params = URI.AbsoluteURI - (Just scheme) - (URI.HierarchicalPart (Just (URI.Authority Nothing (pure host))) Nothing) + (scheme) + (URI.HierarchicalPartAuth (URI.Authority Nothing host) Nothing) params -extractHost' ∷ URI.Scheme → String → Either String Host -extractHost' scheme@(URI.Scheme name) uri = do - URI.AbsoluteURI scheme' (URI.HierarchicalPart auth _) _ ← - lmap show $ AbsoluteURI.parse uri - unless (scheme' == Just scheme) $ Left $ "Expected '" <> name <> "' URL scheme" - extractHost auth + +extractHost' ∷ URI.Scheme → String → Either String URI.QURIHost +extractHost' scheme uri = do + URI.AbsoluteURI scheme' hierPart _ ← lmap show $ runParser uri URI.qAbsoluteURI.parser + unless (scheme' == scheme) $ Left $ "Expected '" <> URI.printScheme scheme <> "' URL scheme" + case hierPart of + URI.HierarchicalPartNoAuth _ -> Left $ "Expected auth part to be present in URL" + URI.HierarchicalPartAuth (URI.Authority _ host) _ -> pure host sparkURIScheme ∷ URI.Scheme -sparkURIScheme = URI.Scheme "spark" +sparkURIScheme = URI.unsafeSchemaFromString "spark" hdfsURIScheme ∷ URI.Scheme -hdfsURIScheme = URI.Scheme "hdfs" +hdfsURIScheme = URI.unsafeSchemaFromString "hdfs" diff --git a/src/Quasar/Mount/SparkLocal.purs b/src/Quasar/Mount/SparkLocal.purs index 9d97e38..cac42e2 100644 --- a/src/Quasar/Mount/SparkLocal.purs +++ b/src/Quasar/Mount/SparkLocal.purs @@ -19,22 +19,22 @@ module Quasar.Mount.SparkLocal , toJSON , fromJSON , parseDirPath - , module Exports ) where import Prelude -import Data.Path.Pathy as P + import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Either (Either(..)) import Data.Maybe (Maybe, maybe) -import Data.Path.Pathy (Abs, Dir, Path, Sandboxed, Unsandboxed, ()) -import Quasar.Mount.Common (Host) as Exports +import Data.Path.Pathy (class SplitDirOrFile, Abs, Dir, Path, Sandboxed, Unsandboxed, ()) +import Data.Path.Pathy as P type Config = Path Abs Dir Sandboxed sandbox ∷ forall a - . Path Abs a Unsandboxed + . SplitDirOrFile a + => Path Abs a Unsandboxed → Maybe (Path Abs a Sandboxed) sandbox = map (P.rootDir _) <<< P.sandbox P.rootDir diff --git a/src/Quasar/Mount/View.purs b/src/Quasar/Mount/View.purs index 76bbd59..9296f20 100644 --- a/src/Quasar/Mount/View.purs +++ b/src/Quasar/Mount/View.purs @@ -22,18 +22,15 @@ import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (~>), (:=)) import Data.Bifunctor (bimap, lmap) import Data.Either (Either(..)) import Data.Foldable (foldMap) -import Data.List ((:), List(..)) -import Data.List as List import Data.Maybe (Maybe(..), maybe) import Data.StrMap as SM import Data.String as Str import Data.Tuple (Tuple(..), lookup) -import Data.URI as URI -import Data.URI.AbsoluteURI as AbsoluteURI +import Quasar.Data.URI as URI import Quasar.Types (Vars) import SqlSquared (SqlQuery) import SqlSquared as Sql -import Text.Parsing.Parser (ParseError(..)) +import Text.Parsing.Parser (ParseError(..), runParser) import Text.Parsing.Parser.Pos (Position(..)) type Config = @@ -43,33 +40,33 @@ type Config = toJSON ∷ Config → Json toJSON config = - let uri = AbsoluteURI.print (toURI config) + let uri = URI.qAbsoluteURI.print (toURI config) in "view" := ("connectionUri" := uri ~> jsonEmptyObject) ~> jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON = fromURI - <=< lmap show <<< AbsoluteURI.parse + <=< lmap show <<< flip runParser URI.qAbsoluteURI.parser <=< (_ .? "connectionUri") <=< (_ .? "view") <=< decodeJson -toURI ∷ Config → URI.AbsoluteURI +toURI ∷ Config → URI.QAbsoluteURI toURI { query, vars } = URI.AbsoluteURI - (Just uriScheme) - (URI.HierarchicalPart Nothing Nothing) - (Just (URI.Query props)) + (uriScheme) + (URI.HierarchicalPartNoAuth Nothing) + (Just (URI.QueryPairs props)) where - props ∷ List (Tuple String (Maybe String)) + props ∷ Array (Tuple String (Maybe String)) props - = Tuple "q" (Just $ Sql.printQuery query) - : (bimap ("var." <> _) Just <$> SM.toUnfoldable vars) + = [ Tuple "q" (Just $ Sql.printQuery query) ] + <> (bimap ("var." <> _) Just <$> SM.toUnfoldable vars) -fromURI ∷ URI.AbsoluteURI → Either String Config +fromURI ∷ URI.QAbsoluteURI → Either String Config fromURI (URI.AbsoluteURI scheme _ query) = do - unless (scheme == Just uriScheme) $ Left "Expected 'sql2' URL scheme" - let queryMap = maybe List.Nil (\(URI.Query q) → q) query + unless (scheme == uriScheme) $ Left "Expected 'sql2' URL scheme" + let queryMap = maybe [] (\(URI.QueryPairs q) → q) query query' ← maybe (Left "Expected 'q' query variable") pure (extractQuery queryMap) q ← Sql.parseQuery query' # lmap \(ParseError err (Position { line , column })) → "Expected 'q' query variable to contain valid query, " <> "but at line " @@ -78,11 +75,11 @@ fromURI (URI.AbsoluteURI scheme _ query) = do pure { query: q, vars } uriScheme ∷ URI.Scheme -uriScheme = URI.Scheme "sql2" +uriScheme = URI.unsafeSchemaFromString "sql2" -extractQuery ∷ List (Tuple String (Maybe String)) → Maybe String +extractQuery ∷ Array (Tuple String (Maybe String)) → Maybe String extractQuery= join <<< lookup "q" -extractVar ∷ Tuple String (Maybe String) → List (Tuple String String) -extractVar (Tuple key val) = maybe Nil List.singleton $ +extractVar ∷ Tuple String (Maybe String) → Array (Tuple String String) +extractVar (Tuple key val) = maybe [] pure $ Tuple <$> Str.stripPrefix (Str.Pattern "var.") key <*> val diff --git a/src/Quasar/Paths.purs b/src/Quasar/Paths.purs index 42ffe09..26589ad 100644 --- a/src/Quasar/Paths.purs +++ b/src/Quasar/Paths.purs @@ -16,31 +16,33 @@ limitations under the License. module Quasar.Paths where -import Data.Path.Pathy (RelDir, RelFile, Sandboxed, file, dir, ()) +import Data.Path.Pathy (RelDir, RelFile, Sandboxed, ()) +import Data.Symbol (SProxy(..)) +import Quasar.Internal (file_, dir_) upload ∷ RelFile Sandboxed -upload = file "upload" +upload = file_ (SProxy :: SProxy "upload") metadata ∷ RelDir Sandboxed -metadata = dir "metadata" dir "fs" +metadata = dir_ (SProxy :: SProxy "metadata") dir_ (SProxy :: SProxy "fs") metastore ∷ RelFile Sandboxed -metastore = file "metastore" +metastore = file_ (SProxy :: SProxy "metastore") mount ∷ RelDir Sandboxed -mount = dir "mount" dir "fs" +mount = dir_ (SProxy :: SProxy "mount") dir_ (SProxy :: SProxy "fs") data_ ∷ RelDir Sandboxed -data_ = dir "data" dir "fs" +data_ = dir_ (SProxy :: SProxy "data") dir_ (SProxy :: SProxy "fs") query ∷ RelDir Sandboxed -query = dir "query" dir "fs" +query = dir_ (SProxy :: SProxy "query") dir_ (SProxy :: SProxy "fs") compile ∷ RelDir Sandboxed -compile = dir "compile" dir "fs" +compile = dir_ (SProxy :: SProxy "compile") dir_ (SProxy :: SProxy "fs") serverInfo ∷ RelFile Sandboxed -serverInfo = dir "server" file "info" +serverInfo = dir_ (SProxy :: SProxy "server") file_ (SProxy :: SProxy "info") invoke ∷ RelDir Sandboxed -invoke = dir "invoke" dir "fs" +invoke = dir_ (SProxy :: SProxy "invoke") dir_ (SProxy :: SProxy "fs") diff --git a/src/Quasar/QuasarF/Interpreter/Affjax.purs b/src/Quasar/QuasarF/Interpreter/Affjax.purs index 4f903a5..9c4410b 100644 --- a/src/Quasar/QuasarF/Interpreter/Affjax.purs +++ b/src/Quasar/QuasarF/Interpreter/Affjax.purs @@ -28,26 +28,26 @@ import Control.Monad.Free (Free) import Data.Argonaut (Json, JObject, jsonEmptyObject, (:=), (~>)) import Data.Array (catMaybes) import Data.Bifunctor (lmap) +import Data.Bitraversable (bitraverse) import Data.Either (Either(..), either) import Data.Foldable (class Foldable, foldl, foldMap) import Data.Functor.Coproduct (Coproduct) import Data.HTTP.Method (Method(..)) import Data.Int as Int -import Data.List (singleton) -import Data.Maybe (Maybe(..), maybe) +import Data.Maybe (Maybe(..)) import Data.MediaType.Common (applicationJSON) import Data.Monoid (mempty) -import Data.Path.Pathy (peel, printPath, rootDir, runDirName, runFileName) +import Data.Path.Pathy (absolutify, peel, printPath, rootDir, runName, sandbox) import Data.StrMap as SM import Data.Time.Duration (Seconds(..)) import Data.Tuple (Tuple(..), fst, snd) -import Data.URI as URI import Network.HTTP.Affjax.Request (RequestContent, toRequest) import Network.HTTP.AffjaxF as AXF import Network.HTTP.RequestHeader as Req import Quasar.ConfigF as CF import Quasar.Data.Json as Json import Quasar.Data.MediaTypes (applicationZip) +import Quasar.Data.URI as URI import Quasar.FS.DirMetadata as DirMetadata import Quasar.Metastore as Metastore import Quasar.Mount as Mount @@ -142,7 +142,7 @@ eval = case _ of InvokeFile mode path vars pagination k → do -- We can't use toVarParams here, as the format is different for invokeFile, -- instead of var.x=3 it's just x=3 - url ← mkFSUrl Paths.invoke (Right path) (URI.Query (map Just <$> SM.toUnfoldable vars) <> toPageParams pagination) + url ← mkFSUrl Paths.invoke (Right path) (URI.QueryPairs (map Just <$> SM.toUnfoldable vars) <> toPageParams pagination) k <$> mkRequest jsonResult (AXF.affjax defaultRequest { url = url @@ -162,11 +162,21 @@ eval = case _ of }) CreateMount path config mbMaxAge k → do - let pathParts = either peel peel path - parentDir = maybe rootDir fst pathParts - name = maybe "" (either runDirName runFileName <<< snd) pathParts - filenameHeader = Tuple "X-File-Name" name - url ← mkFSUrl Paths.mount (Left parentDir) (headerParams [filenameHeader]) + let + -- TODO simplify this + Tuple parentDir name = case bitraverse peel peel path of + Nothing -> Tuple rootDir "" + Just (Left (Tuple parentDir name)) -> case sandbox rootDir parentDir of + Nothing -> + Tuple rootDir "" + Just spd -> + Tuple (absolutify spd) (runName name) + Just (Right (Tuple parentDir name)) -> case sandbox rootDir parentDir of + Nothing -> + Tuple rootDir "" + Just spd -> + Tuple (absolutify spd) (runName name) + url ← mkFSUrl Paths.mount (Left parentDir) (headerParams [Tuple "X-File-Name" name]) k <$> mkRequest unitResult (AXF.affjax defaultRequest { url = url @@ -193,8 +203,8 @@ eval = case _ of k <$> mkRequest metastoreResult (get url) PutMetastore { initialize, metastore } k → do - let query = if initialize then URI.Query (singleton (Tuple "initialize" Nothing)) else mempty - url ← mkUrl (Right Paths.metastore) query + let query = if initialize then [Tuple "initialize" Nothing] else [] + url ← mkUrl (Right Paths.metastore) (URI.QueryPairs query) k <$> (mkRequest unitResult $ put url $ snd (toRequest (Metastore.toJSON metastore))) @@ -216,10 +226,10 @@ fileMetaResult = map (\(_ ∷ JObject) → unit) <<< jsonResult metastoreResult ∷ String → Either Error (Metastore.Metastore ()) metastoreResult = lmap error <$> Metastore.fromJSON <=< jsonResult -querySingleton ∷ String → String → URI.Query -querySingleton k v = URI.Query $ singleton $ Tuple k (Just v) +querySingleton ∷ String → String → URI.QQuery +querySingleton k v = URI.QueryPairs [ Tuple k (Just v) ] -headerParams ∷ ∀ f. Foldable f ⇒ f (Tuple String String) → URI.Query +headerParams ∷ ∀ f. Foldable f ⇒ f (Tuple String String) → URI.QQuery headerParams ps = querySingleton "request-headers" (show (foldl go jsonEmptyObject ps)) where go ∷ Json → Tuple String String → Json diff --git a/src/Quasar/QuasarF/Interpreter/Config.purs b/src/Quasar/QuasarF/Interpreter/Config.purs index ed6f477..a887db3 100644 --- a/src/Quasar/QuasarF/Interpreter/Config.purs +++ b/src/Quasar/QuasarF/Interpreter/Config.purs @@ -19,9 +19,9 @@ module Quasar.QuasarF.Interpreter.Config where import Data.Either (Either) import Data.Maybe (Maybe) import Data.Path.Pathy (AbsDir, RelDir, Sandboxed, Unsandboxed) -import Data.URI as URI +import Quasar.Data.URI as URI -type AbsBasePath = { scheme ∷ URI.Scheme, authority ∷ Maybe URI.Authority, path ∷ AbsDir Sandboxed } +type AbsBasePath = { scheme ∷ URI.Scheme, authority ∷ Maybe URI.QAuthority, path ∷ AbsDir Sandboxed } type BasePath = Either AbsBasePath (RelDir Unsandboxed) type Config r = { basePath ∷ BasePath | r } diff --git a/src/Quasar/QuasarF/Interpreter/Internal.purs b/src/Quasar/QuasarF/Interpreter/Internal.purs index 1656d48..98d23e9 100644 --- a/src/Quasar/QuasarF/Interpreter/Internal.purs +++ b/src/Quasar/QuasarF/Interpreter/Internal.purs @@ -42,26 +42,25 @@ import Data.Either (Either(..), either) import Data.Foldable (oneOf) import Data.Functor.Coproduct (Coproduct, left, right) import Data.HTTP.Method (Method(..)) -import Data.List (List(..), (:)) import Data.Maybe (Maybe(..), fromMaybe) import Data.Monoid (mempty) -import Data.Path.Pathy (Abs, AnyPath, Path, Rel, RelDir, RelPath, Sandboxed, dir, file, relativeTo, rootDir, unsandbox, ()) +import Data.Path.Pathy (class SplitDirOrFile, Abs, AnyPath, Path, Rel, RelDir, RelPath, Sandboxed, Unsandboxed, relativify, ()) + import Data.StrMap as SM import Data.String as Str import Data.Tuple (Tuple(..)) -import Data.URI as URI -import Data.URI.URIRef as URIRef import Network.HTTP.Affjax as AX import Network.HTTP.Affjax.Request (RequestContent) import Network.HTTP.AffjaxF as AXF import Network.HTTP.ResponseHeader as RH import Network.HTTP.StatusCode (StatusCode(..)) import Quasar.ConfigF as CF +import Quasar.Data.URI as URI import Quasar.QuasarF (Pagination, QError(..), PDFError(..), UnauthorizedDetails(..)) import Quasar.QuasarF.Interpreter.Config (Config) -import Unsafe.Coerce (unsafeCoerce) type AXFP = AXF.AffjaxFP RequestContent String +type AjaxM r a = Free (Coproduct (CF.ConfigF (Config r)) AXFP) a ask ∷ ∀ c r. Free (Coproduct (CF.ConfigF c) r) c ask = liftF $ left $ CF.GetConfig id @@ -75,13 +74,15 @@ strResult = Right unitResult ∷ String → Either Error Unit unitResult = const (Right unit) -toVarParams ∷ SM.StrMap String → URI.Query -toVarParams = URI.Query <<< map (bimap ("var." <> _) Just) <<< SM.toUnfoldable +toVarParams ∷ SM.StrMap String → URI.QQuery +toVarParams = URI.QueryPairs <<< map (bimap ("var." <> _) Just) <<< SM.toUnfoldable -toPageParams ∷ Maybe Pagination → URI.Query +toPageParams ∷ Maybe Pagination → URI.QQuery toPageParams Nothing = mempty -toPageParams (Just { offset, limit }) - = URI.Query $ Tuple "offset" (Just (show offset)) : Tuple "limit" (Just (show limit)) : Nil +toPageParams (Just { offset, limit }) = URI.QueryPairs + [ Tuple "offset" (Just (show offset)) + , Tuple "limit" (Just (show limit)) + ] defaultRequest ∷ AX.AffjaxRequest RequestContent defaultRequest = AX.defaultRequest { content = Nothing } @@ -96,54 +97,58 @@ delete ∷ AX.URL → AXF.AffjaxF RequestContent String delete u = AXF.affjax (defaultRequest { method = Left DELETE, url = u }) mkFSUrl - ∷ ∀ s s' r - . RelDir s - → AnyPath Abs s' - → URI.Query - → Free (Coproduct (CF.ConfigF (Config r)) AXFP) String + ∷ ∀ r + . RelDir Sandboxed + → AnyPath Abs Sandboxed + → URI.QQuery + → AjaxM r String mkFSUrl relDir fsPath q = do - uri ← URIRef.print <$> mkFSUrl' relDir fsPath q + uri ← URI.qURIRef.print <$> mkFSUrl' relDir fsPath q pure uri mkFSUrl' - ∷ ∀ s s' r - . RelDir s - → AnyPath Abs s' - → URI.Query - → Free (Coproduct (CF.ConfigF (Config r)) AXFP) URI.URIRef -mkFSUrl' relDir fsPath = mkUrl' (bimap (baseify (dir "/")) (baseify (file "")) fsPath) + ∷ ∀ r + . RelDir Sandboxed + → AnyPath Abs Sandboxed + → URI.QQuery + → AjaxM r URI.QURIRef +mkFSUrl' relDir fsPath = mkUrl' (bimap baseify baseify fsPath) where - baseify ∷ ∀ b. Path Rel b s → Path Abs b s' → Path Rel b s - baseify x p = relDir fromMaybe x (p `relativeTo` rootDir) + baseify ∷ ∀ b. SplitDirOrFile b => Path Abs b Sandboxed → Path Rel b Sandboxed + baseify p = relDir relativify p -mkUrl ∷ ∀ s r. RelPath s → URI.Query → Free (Coproduct (CF.ConfigF (Config r)) AXFP) String -mkUrl relPath q = URIRef.print <$> mkUrl' relPath q +mkUrl ∷ ∀ s r. RelPath Sandboxed → URI.QQuery → AjaxM r String +mkUrl relPath q = URI.qURIRef.print <$> mkUrl' relPath q -mkUrl' ∷ ∀ s r. RelPath s → URI.Query → Free (Coproduct (CF.ConfigF (Config r)) AXFP) URI.URIRef +mkUrl' ∷ ∀ s r. RelPath Sandboxed → URI.QQuery → AjaxM r URI.QURIRef mkUrl' relPath q = do { basePath } ← ask pure (bimap toURI toRelativeRef basePath) where toURI { scheme, authority, path } = URI.URI - (Just scheme) - (URI.HierarchicalPart - authority - (Just (bimap ((path _) <<< sandbox) ((path _) <<< sandbox) relPath))) + scheme + (case authority of + Nothing -> + URI.HierarchicalPartNoAuth + (Just (bimap (path _) (path _) relPath)) + Just authority' -> + URI.HierarchicalPartAuth + authority' + (Just (bimap (path _) (path _) relPath)) + ) (if q == mempty then Nothing else Just q) Nothing - sandbox ∷ ∀ a b. Path a b s → Path a b Sandboxed - sandbox = unsafeCoerce - - toRelativeRef relDir = + toRelativeRef :: RelDir Unsandboxed -> URI.QRelativeRef + toRelativeRef relDir = URI.RelativeRef - (URI.RelativePart - Nothing - (Just (bimap ((relDir _) <<< unsandbox) ((relDir _) <<< unsandbox) relPath))) + (URI.RelativePartNoAuth + (Just $ Right (bimap (relDir _) (relDir _) relPath))) (if q == mempty then Nothing else Just q) Nothing + mkRequest ∷ ∀ a l . (String → Either Error a) diff --git a/test/src/Test/Main.purs b/test/src/Test/Main.purs index 5b04df4..0c75601 100644 --- a/test/src/Test/Main.purs +++ b/test/src/Test/Main.purs @@ -38,8 +38,9 @@ import Data.Path.Pathy (rootDir, dir, file, ()) import Data.Posix.Signal (Signal(SIGTERM)) import Data.StrMap as SM import Data.String as Str +import Data.Symbol (SProxy(..)) +import Data.These (These(..)) import Data.Tuple (Tuple(..)) -import Data.URI as URI import Network.HTTP.Affjax (AJAX) import Node.ChildProcess as CP import Node.Encoding (Encoding(..)) @@ -51,6 +52,8 @@ import Partial.Unsafe (unsafePartial) import Quasar.Advanced.QuasarAF.Interpreter.Aff (Config, eval) import Quasar.Data (QData(..)) import Quasar.Data.Json as Json +import Quasar.Data.URI as URI +import Quasar.Internal (dir_, file_) import Quasar.Mount (MountConfig(..)) import Quasar.QuasarF (QuasarF, QError(..)) import Quasar.QuasarF as QF @@ -76,8 +79,8 @@ run pred qf = do config ∷ Config () config = { basePath: Left - { scheme: URI.Scheme "http" - , authority: Just (URI.Authority Nothing [Tuple (URI.NameAddress "localhost") (Just (URI.Port 53174))]) + { scheme: URI.unsafeSchemaFromString "http" + , authority: Just (URI.Authority Nothing [Both (URI.NameAddress $ URI.unsafeRegNameFromString "localhost") (URI.unsafePortFromInt 53174)]) , path: rootDir } , idToken: Nothing @@ -209,16 +212,16 @@ main = void $ runAff (const (pure unit)) $ jumpOutOnError do where testDbAnyDir = rootDir - nonexistant = rootDir file "nonexistant" - testFile1 = rootDir file "test1" - testFile2Dir = rootDir dir "subdir" - testFile2 = testFile2Dir file "test2" - testFile3Dir = rootDir dir "what" - testFile3 = testFile3Dir file "test2" - testMount = rootDir file "testMount" - testMount2 = rootDir file "testMount2" - testMount3 = rootDir dir "testMount3" dir "" - testProcess = rootDir dir "testMount3" file "test" + nonexistant = rootDir file_ (SProxy :: SProxy "nonexistant") + testFile1 = rootDir file_ (SProxy :: SProxy "test1") + testFile2Dir = rootDir dir_ (SProxy :: SProxy "subdir") + testFile2 = testFile2Dir file_ (SProxy :: SProxy "test2") + testFile3Dir = rootDir dir_ (SProxy :: SProxy "what") + testFile3 = testFile3Dir file_ (SProxy :: SProxy "test2") + testMount = rootDir file_ (SProxy :: SProxy "testMount") + testMount2 = rootDir file_ (SProxy :: SProxy "testMount2") + testMount3 = rootDir dir_ (SProxy :: SProxy "testMount3") + testProcess = rootDir dir_ (SProxy :: SProxy "testMount3") file_ (SProxy :: SProxy "test") isNotFound ∷ ∀ a. Either QError a → Boolean isNotFound e = case e of diff --git a/test/src/Test/Unit/Main.purs b/test/src/Test/Unit/Main.purs index abe6e6c..4449af0 100644 --- a/test/src/Test/Unit/Main.purs +++ b/test/src/Test/Unit/Main.purs @@ -25,15 +25,19 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Monoid (mempty) import Data.NonEmpty as NE +import Data.String.NonEmpty (fromString) +import Data.These (These(..)) import Data.Time.Duration (Seconds(..)) import Data.Tuple (Tuple(..)) -import Data.URI as URI import Data.URI.AbsoluteURI as AbsoluteURI +import Quasar.Data.URI (portFromInt) +import Quasar.Data.URI as URI import Quasar.Mount as QM import Quasar.Mount.Couchbase as CB import Quasar.Mount.MongoDB as Mongo import Test.Assert (ASSERT, assert') import Test.Property.Mount.Couchbase as CBT +import Text.Parsing.Parser (runParser) main ∷ ∀ eff. Eff (assert ∷ ASSERT, console ∷ CONSOLE | eff) Unit main = do @@ -51,8 +55,8 @@ main = do testURIParse (map CBT.TestConfig <$> CB.fromURI) "couchbase://localhost/testBucket?password=&docTypeKey=" (CBT.TestConfig - { host: Tuple (URI.NameAddress "localhost") Nothing - , bucketName: "testBucket" + { host: [ This (URI.NameAddress $ URI.unsafeRegNameFromString "localhost") ] + , bucketName: fromString "testBucket" , password: "" , docTypeKey: "" , queryTimeout: Nothing @@ -61,16 +65,16 @@ main = do testURIParse (map CBT.TestConfig <$> CB.fromURI) "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (CBT.TestConfig - { host: Tuple (URI.NameAddress "localhost") (Just (URI.Port 99999)) - , bucketName: "testBucket" + { host: [Both (URI.NameAddress $ URI.unsafeRegNameFromString "localhost") (URI.unsafePortFromInt 99999)] + , bucketName: fromString "testBucket" , password: "pass" , docTypeKey: "type" , queryTimeout: Just (Seconds (20.0)) }) let mongoURI = - AbsoluteURI.print + URI.qAbsoluteURI.print (Mongo.toURI - { hosts: NE.singleton (Tuple (URI.NameAddress "localhost") (Just (URI.Port 12345))) + { hosts: [Both (URI.NameAddress $ URI.unsafeRegNameFromString "localhost") (URI.unsafePortFromInt 12345)] , auth: Nothing , props: mempty}) if mongoURI == "mongodb://localhost:12345/" @@ -81,12 +85,12 @@ testURIParse ∷ ∀ a eff . Eq a ⇒ Show a - ⇒ (URI.AbsoluteURI → Either String a) + ⇒ (URI.QAbsoluteURI → Either String a) → String → a → Eff (assert :: ASSERT | eff) Unit testURIParse fromURI uri expected = - case AbsoluteURI.parse uri of + case runParser uri URI.qAbsoluteURI.parser of Left err → fail $ "Test URI failed to parse as a URI even: \n\n\t" <> uri <> "\n\n\t" <> show err <> "\n\n" Right auri → case fromURI auri of From 0ff247f87f12c1f875fae3088d83300030ee0d86 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Fri, 16 Feb 2018 16:49:48 +0100 Subject: [PATCH 02/33] add final empty segment for dir pathes --- src/Quasar/Data/URI.purs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Quasar/Data/URI.purs b/src/Quasar/Data/URI.purs index 63736af..7a7f614 100644 --- a/src/Quasar/Data/URI.purs +++ b/src/Quasar/Data/URI.purs @@ -150,8 +150,7 @@ opts = printPath = bimap Py.viewDir Py.viewFile >>>case _ of Left d -> URI.Path - $ fromFoldable d - <#> Py.runName >>> segmentFromString + $ (fromFoldable d <#> Py.runName >>> segmentFromString) <> [ segmentFromString "" ] Right (Tuple d n) -> URI.Path $ (fromFoldable d <#> asSegment) <> [asSegment n] @@ -185,7 +184,7 @@ opts = Left Nil -> PathAbsolute.PathAbsolute Nothing Left (Cons head tail) -> PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ head) - $ (asSegment <$> fromFoldable tail) + $ (asSegment <$> fromFoldable tail) <> [ segmentFromString "" ] Right (Tuple d n) -> case d of Nil -> PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ n) [] Cons head tail -> PathAbsolute.PathAbsolute @@ -197,9 +196,10 @@ opts = _printRelPath = bimap Py.viewDirUnsandboxed Py.viewFileUnsandboxed >>> case _ of Left Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString "./") [] Left (Cons head tail) -> - PathNoScheme.PathNoScheme - $ Tuple (unsafeSegmentNZNCFromString $ maybe "../" Py.runName head) - $ (segmentFromString <<< maybe "../" Py.runName <$> fromFoldable tail) + PathNoScheme.PathNoScheme + $ Tuple (unsafeSegmentNZNCFromString $ maybe "../" Py.runName head) + $ (segmentFromString <<< maybe "../" Py.runName <$> fromFoldable tail) <> [ segmentFromString "" ] + Right (Tuple d n) -> case d of Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ Py.runName n) [] Cons head tail -> PathNoScheme.PathNoScheme From 794fe1367edeb00d3b001e25707d3f9bbfbbd373 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Fri, 16 Feb 2018 16:49:58 +0100 Subject: [PATCH 03/33] fix warnings in tests --- test/src/Test/Unit/Main.purs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/test/src/Test/Unit/Main.purs b/test/src/Test/Unit/Main.purs index 4449af0..2cbffe7 100644 --- a/test/src/Test/Unit/Main.purs +++ b/test/src/Test/Unit/Main.purs @@ -24,13 +24,9 @@ import Data.Argonaut.Parser as JP import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Monoid (mempty) -import Data.NonEmpty as NE import Data.String.NonEmpty (fromString) import Data.These (These(..)) import Data.Time.Duration (Seconds(..)) -import Data.Tuple (Tuple(..)) -import Data.URI.AbsoluteURI as AbsoluteURI -import Quasar.Data.URI (portFromInt) import Quasar.Data.URI as URI import Quasar.Mount as QM import Quasar.Mount.Couchbase as CB From f8d02e0d2b4fd584b276618841a68961290a184c Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Mon, 26 Feb 2018 20:02:01 +0400 Subject: [PATCH 04/33] compiles again --- bower.json | 2 +- src/Quasar/Advanced/Paths.purs | 45 +++++---- .../Advanced/QuasarAF/Interpreter/Affjax.purs | 14 +-- .../QuasarAF/Interpreter/Internal.purs | 2 +- src/Quasar/Advanced/Types.purs | 58 +++++------- src/Quasar/Data/URI.purs | 93 ++++++++++++------- src/Quasar/FS/Mount.purs | 16 ++-- src/Quasar/FS/Resource.purs | 16 ++-- src/Quasar/Internal.purs | 24 ----- src/Quasar/Mount/Common/Gen.purs | 2 +- src/Quasar/Mount/Couchbase.purs | 6 +- src/Quasar/Mount/Mimir.purs | 28 ++---- src/Quasar/Mount/MongoDB.purs | 2 +- src/Quasar/Mount/SparkHDFS.purs | 11 +-- src/Quasar/Mount/SparkLocal.purs | 27 ++---- src/Quasar/Mount/View.purs | 4 +- src/Quasar/Paths.purs | 39 ++++---- src/Quasar/QuasarF/Interpreter/Affjax.purs | 23 ++--- src/Quasar/QuasarF/Interpreter/Config.purs | 6 +- src/Quasar/QuasarF/Interpreter/Internal.purs | 29 ++---- src/Quasar/Query/OutputMeta.purs | 12 +-- src/Quasar/Types.purs | 31 ++++--- test/src/Test/Main.purs | 23 +++-- 23 files changed, 227 insertions(+), 286 deletions(-) delete mode 100644 src/Quasar/Internal.purs diff --git a/bower.json b/bower.json index c122665..98102a6 100644 --- a/bower.json +++ b/bower.json @@ -29,7 +29,7 @@ "purescript-string-parsers": "^3.0.0", "purescript-strings": "^3.5.0", "purescript-uri": "garyb/purescript-uri#next", - "purescript-sql-squared": "^0.10.0", + "purescript-sql-squared": "safareli/purescript-sql-squared#pathy", "purescript-const": "^3.2.0" }, "devDependencies": { diff --git a/src/Quasar/Advanced/Paths.purs b/src/Quasar/Advanced/Paths.purs index e729ece..5e7b956 100644 --- a/src/Quasar/Advanced/Paths.purs +++ b/src/Quasar/Advanced/Paths.purs @@ -2,7 +2,7 @@ Copyright 2017 SlamData, Inc. Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file_ except in compliance with the License. +you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0 @@ -16,38 +16,37 @@ limitations under the License. module Quasar.Advanced.Paths where -import Data.Path.Pathy (RelDir, RelFile, Sandboxed, ()) +import Pathy (RelDir, RelFile, dir, file, ()) import Data.Symbol (SProxy(..)) -import Quasar.Internal (dir_, file_) -oidcProviders ∷ RelFile Sandboxed -oidcProviders = dir_ (SProxy :: SProxy "security") dir_ (SProxy :: SProxy "oidc") file_ (SProxy :: SProxy "providers") +oidcProviders ∷ RelFile +oidcProviders = dir (SProxy :: SProxy "security") dir (SProxy :: SProxy "oidc") file (SProxy :: SProxy "providers") -token ∷ RelDir Sandboxed -token = dir_ (SProxy :: SProxy "security") dir_ (SProxy :: SProxy "token") +token ∷ RelDir +token = dir (SProxy :: SProxy "security") dir (SProxy :: SProxy "token") -group ∷ RelDir Sandboxed -group = dir_ (SProxy :: SProxy "security") dir_ (SProxy :: SProxy "group") +group ∷ RelDir +group = dir (SProxy :: SProxy "security") dir (SProxy :: SProxy "group") -permission ∷ RelDir Sandboxed -permission = dir_ (SProxy :: SProxy "security") dir_ (SProxy :: SProxy "permission") +permission ∷ RelDir +permission = dir (SProxy :: SProxy "security") dir (SProxy :: SProxy "permission") -children ∷ RelFile Sandboxed -children = file_ (SProxy :: SProxy "children") +children ∷ RelFile +children = file (SProxy :: SProxy "children") -authority ∷ RelDir Sandboxed -authority = dir_ (SProxy :: SProxy "security") dir_ (SProxy :: SProxy "authority") +authority ∷ RelDir +authority = dir (SProxy :: SProxy "security") dir (SProxy :: SProxy "authority") -licenseInfo ∷ RelFile Sandboxed -licenseInfo = dir_ (SProxy :: SProxy "server") file_ (SProxy :: SProxy "licenseInfo") +licenseInfo ∷ RelFile +licenseInfo = dir (SProxy :: SProxy "server") file (SProxy :: SProxy "licenseInfo") -licensee ∷ RelFile Sandboxed -licensee = dir_ (SProxy :: SProxy "server") file_ (SProxy :: SProxy "licensee") +licensee ∷ RelFile +licensee = dir (SProxy :: SProxy "server") file (SProxy :: SProxy "licensee") -pdfInfo ∷ RelFile Sandboxed -pdfInfo = dir_ (SProxy :: SProxy "service") dir_ (SProxy :: SProxy "pdf") file_ (SProxy :: SProxy "info") +pdfInfo ∷ RelFile +pdfInfo = dir (SProxy :: SProxy "service") dir (SProxy :: SProxy "pdf") file (SProxy :: SProxy "info") -generatePdf ∷ RelFile Sandboxed -generatePdf = dir_ (SProxy :: SProxy "service") dir_ (SProxy :: SProxy "pdf") file_ (SProxy :: SProxy "generate") +generatePdf ∷ RelFile +generatePdf = dir (SProxy :: SProxy "service") dir (SProxy :: SProxy "pdf") file (SProxy :: SProxy "generate") diff --git a/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs b/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs index 908dcd5..c2eb355 100644 --- a/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs +++ b/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs @@ -34,8 +34,6 @@ import Data.Functor.Coproduct (Coproduct, left, right, coproduct) import Data.HTTP.Method (Method(..)) import Data.Maybe (Maybe(..), maybe) import Data.Monoid (mempty) -import Data.Path.Pathy (()) -import Data.Path.Pathy as Pt import Data.String as Str import Data.Tuple (Tuple(..), snd) import Network.HTTP.Affjax as AX @@ -43,6 +41,8 @@ import Network.HTTP.Affjax.Request (RequestContent, toRequest) import Network.HTTP.AffjaxF as AXF import Network.HTTP.RequestHeader as Req import OIDC.Crypt.Types as OIDC +import Pathy (Name(..), ()) +import Pathy as Pt import Quasar.Advanced.Paths as Paths import Quasar.Advanced.QuasarAF (QuasarAFC, QuasarAF(..)) import Quasar.Advanced.QuasarAF.Interpreter.Config (Config) @@ -119,7 +119,7 @@ evalQuasarAdvanced (AuthorityList k) = do evalQuasarAdvanced (PermissionInfo pid k) = do config ← ask url ← mkUrl - (Right (Paths.permission Pt.file (Qa.runPermissionId pid))) + (Right (Paths.permission Pt.file' (Name $ Qa.runPermissionId pid))) (URI.QueryPairs [Tuple "transitive" Nothing]) map k $ mkAuthedRequest (jsonResult >>> map Qa.runPermission) @@ -127,7 +127,7 @@ evalQuasarAdvanced (PermissionInfo pid k) = do evalQuasarAdvanced (PermissionChildren pid isTransitive k) = do config ← ask url ← mkUrl - (Right (Paths.permission Pt.dir (Qa.runPermissionId pid) Paths.children )) + (Right (Paths.permission Pt.dir' (Name $ Qa.runPermissionId pid) Paths.children )) (transitiveQuery isTransitive) map k $ mkAuthedRequest (jsonResult >>> map (map Qa.runPermission)) @@ -144,7 +144,7 @@ evalQuasarAdvanced (SharePermission req k) = do evalQuasarAdvanced (DeletePermission pid k) = do config ← ask url ← mkUrl - (Right (Paths.permission Pt.file (Qa.runPermissionId pid))) + (Right (Paths.permission Pt.file' (Name $ Qa.runPermissionId pid))) mempty map k $ mkAuthedRequest unitResult @@ -160,7 +160,7 @@ evalQuasarAdvanced (TokenList k) = do evalQuasarAdvanced (TokenInfo tid k) = do config ← ask url ← mkUrl - (Right (Paths.token Pt.file (Qa.runTokenId tid))) + (Right (Paths.token Pt.file' (Name $ Qa.runTokenId tid))) mempty map k $ mkAuthedRequest (jsonResult >>> map Qa.runToken) @@ -181,7 +181,7 @@ evalQuasarAdvanced (CreateToken mbName actions k) = do evalQuasarAdvanced (DeleteToken tid k) = do config ← ask url ← mkUrl - (Right (Paths.token Pt.file (Qa.runTokenId tid))) + (Right (Paths.token Pt.file' (Name $ Qa.runTokenId tid))) mempty map k $ mkAuthedRequest unitResult diff --git a/src/Quasar/Advanced/QuasarAF/Interpreter/Internal.purs b/src/Quasar/Advanced/QuasarAF/Interpreter/Internal.purs index a94f94a..d4e35ac 100644 --- a/src/Quasar/Advanced/QuasarAF/Interpreter/Internal.purs +++ b/src/Quasar/Advanced/QuasarAF/Interpreter/Internal.purs @@ -22,7 +22,7 @@ import Control.Monad.Free (Free) import Data.Either (Either(..)) import Data.Functor.Coproduct (Coproduct) import Data.Maybe (Maybe(..)) -import Data.Path.Pathy (rootDir) +import Pathy (rootDir) import Data.String as String import Quasar.Data.URI as URI import Network.HTTP.Affjax.Request (RequestContent) diff --git a/src/Quasar/Advanced/Types.purs b/src/Quasar/Advanced/Types.purs index 0d44f8f..83e3d53 100644 --- a/src/Quasar/Advanced/Types.purs +++ b/src/Quasar/Advanced/Types.purs @@ -5,18 +5,18 @@ import Prelude import Control.Alt ((<|>)) import Data.Argonaut (class EncodeJson, class DecodeJson, encodeJson, decodeJson, Json, JString, (.?), (:=), (~>), jsonEmptyObject) import Data.Bifunctor (lmap) -import Data.Either (Either(..)) +import Data.Either (Either(..), note) import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe) import Data.Newtype as Newtype -import Data.Path.Pathy (()) -import Data.Path.Pathy as Pt import Data.String as Str import Data.String.NonEmpty (NonEmptyString, fromString, toString) import Data.Traversable (traverse) import OIDC.Crypt.JSONWebKey (JSONWebKey) import OIDC.Crypt.Types (Issuer(..), ClientId(..)) +import Pathy (rootDir) +import Quasar.Types (DirPath, FilePath, parseQDirPath, parseQFilePath, printQPath) -newtype GroupPath = GroupPath (Pt.AbsDir Pt.Sandboxed) +newtype GroupPath = GroupPath DirPath derive instance eqGroupPath ∷ Eq GroupPath derive instance ordGroupPath ∷ Ord GroupPath @@ -28,13 +28,13 @@ printGroupPath gp = dir = Newtype.un GroupPath gp in -- TODO(Christoph): Get rid of this once quasar treats Groups as directories - if dir == Pt.rootDir - then Pt.printPath dir - else fromMaybe "/" (Str.stripSuffix (Str.Pattern "/") (Pt.printPath dir)) + if dir == rootDir + then printQPath dir + else fromMaybe "/" (Str.stripSuffix (Str.Pattern "/") (printQPath dir)) parseGroupPath ∷ String → Either String GroupPath -- TODO(Christoph): Clean this up once Quasar treats Groups as directories -parseGroupPath s = map GroupPath if s == "/" then Right Pt.rootDir else parseDir (s <> "/") +parseGroupPath s = map GroupPath if s == "/" then Right rootDir else parseDir (s <> "/") data Operation = Add @@ -84,16 +84,16 @@ instance decodeJsonAccessType ∷ DecodeJson AccessType where data QResource - = File (Pt.AbsFile Pt.Sandboxed) - | Dir (Pt.AbsDir Pt.Sandboxed) + = File FilePath + | Dir DirPath | Group GroupPath derive instance eqQResource ∷ Eq QResource derive instance ordQResource ∷ Ord QResource instance encodeJsonQResource ∷ EncodeJson QResource where - encodeJson (File pt) = encodeJson $ "data:" <> Pt.printPath pt - encodeJson (Dir pt) = encodeJson $ "data:" <> Pt.printPath pt + encodeJson (File pt) = encodeJson $ "data:" <> printQPath pt + encodeJson (Dir pt) = encodeJson $ "data:" <> printQPath pt encodeJson (Group gpt) = encodeJson $ "group:" <> printGroupPath gpt instance decodeJsonQResource ∷ DecodeJson QResource where @@ -113,19 +113,11 @@ instance decodeJsonQResource ∷ DecodeJson QResource where <|> (map Dir $ lmap (const $ "Incorrect directory resource") $ parseDir pt) -parseFile ∷ String → Either String (Pt.AbsFile Pt.Sandboxed) -parseFile pt = - Pt.parseAbsFile pt - >>= Pt.sandbox Pt.rootDir - <#> (Pt.rootDir _) - # maybe (Left "Incorrect resource") pure +parseFile ∷ String → Either String FilePath +parseFile = parseQFilePath >>> note "Incorrect resource" -parseDir ∷ String → Either String (Pt.AbsDir Pt.Sandboxed) -parseDir pt = - Pt.parseAbsDir pt - >>= Pt.sandbox Pt.rootDir - <#> (Pt.rootDir _) - # maybe (Left "Incorrect resource") pure +parseDir ∷ String → Either String DirPath +parseDir = parseQDirPath >>> note "Incorrect resource" type ActionR = @@ -246,18 +238,22 @@ instance decodeJsonGrantedTo ∷ DecodeJson GrantedTo where parseUserId str = Str.stripPrefix (Str.Pattern "user:") str >>= fromString - # maybe (Left "Incorrect user") (pure <<< UserId) + # map UserId + # note "Incorrect user" + parseTokenId ∷ String → Either String TokenId parseTokenId str = Str.stripPrefix (Str.Pattern "token:") str >>= fromString - # maybe (Left "Incorrect token") (pure <<< TokenId) + # map TokenId + # note "Incorrect token" + parseGroup ∷ String → Either String GroupPath parseGroup string = Str.stripPrefix (Str.Pattern "group:") string - # maybe (Left "Incorrect group") pure + # note "Incorrect group" >>= parseGroupPath @@ -310,12 +306,8 @@ instance decodeJsonGroupInfo ∷ DecodeJson GroupInfo where traverse \x → note "Incorrect subgroup" do -- Quasar returns file paths for the subgroups, so we have to append a slash - dir ← Pt.parseAbsDir (x <> "/") - sandboxed ← Pt.sandbox Pt.rootDir dir - pure $ GroupPath $ Pt.rootDir sandboxed - -note :: ∀ a b. a → Maybe b → Either a b -note n m = maybe (Left n) Right m + dir ← parseQDirPath (x <> "/") + pure $ GroupPath dir type GroupPatchR = diff --git a/src/Quasar/Data/URI.purs b/src/Quasar/Data/URI.purs index 7a7f614..ecea541 100644 --- a/src/Quasar/Data/URI.purs +++ b/src/Quasar/Data/URI.purs @@ -42,14 +42,15 @@ module Quasar.Data.URI import Prelude import Data.Array (fromFoldable) -import Data.Bifunctor (bimap) +import Data.Bifunctor (bimap, lmap) import Data.Bitraversable (bitraverse) -import Data.Either (Either(..), either) -import Data.List (List(..)) +import Data.Either (Either(..), either, note) +import Data.List (List(..), reverse) import Data.Maybe (Maybe(..), maybe) -import Data.Path.Pathy (class SplitDirOrFile) -import Data.Path.Pathy (Abs, AbsPath, Name, viewDir, viewDirUnsandboxed, viewFile, viewFileUnsandboxed, Path, RelPath, Sandboxed, Unsandboxed, appendPath, parsePath, rootDir, runName, sandbox) as Py +import Data.Newtype (un) import Data.Record.Builder as Builder +import Data.String.NonEmpty (NonEmptyString) +import Data.String.NonEmpty as NES import Data.Tuple (Tuple(..)) import Data.URI (PathAbsolute, PathRootless, RegName) import Data.URI (URI(..), RelativePart(..), Authority(..), AbsoluteURI(..), HierarchicalPart(..), HierPath, Host(..), Path(..), Port, RelativeRef(..), URIRef, Fragment, Query, UserInfo) as URI @@ -77,11 +78,15 @@ import Data.URI.Scheme (unsafeFromString, print) as Scheme import Data.URI.URI (URIOptions) as URI import Data.URI.URIRef (URIRefOptions) as URI import Data.URI.URIRef (print, parser) as URIRef +import Partial.Unsafe (unsafeCrashWith) +import Pathy (foldPath, posixParser) +import Pathy as Py import Text.Parsing.Parser (Parser) import Type.Row (class RowListNub, class RowToList) +import Unsafe.Coerce (unsafeCoerce) -type AbsPath = Py.AbsPath Py.Sandboxed -type RelPath' = Py.RelPath Py.Unsandboxed +type AbsPath = Py.AbsPath +type RelPath' = Py.RelPath type AnyPath = Either AbsPath RelPath' type QURIHost = URI.MultiHostPortPair URI.Host URI.Port type QAuthority = URI.Authority URI.UserPassInfo QURIHost @@ -147,10 +152,10 @@ opts = parsePath :: Path -> Either URIPartParseError AbsPath parsePath = parseAbsSandboxedPath <<< Path.print printPath ∷ AbsPath → Path - printPath = bimap Py.viewDir Py.viewFile >>>case _ of + printPath = bimap viewAbsDir viewAbsFile >>>case _ of Left d -> URI.Path - $ (fromFoldable d <#> Py.runName >>> segmentFromString) <> [ segmentFromString "" ] + $ (fromFoldable d <#> runName >>> segmentFromString) <> [ segmentFromString "" ] Right (Tuple d n) -> URI.Path $ (fromFoldable d <#> asSegment) <> [asSegment n] @@ -180,7 +185,7 @@ opts = _printRelPath _printAbsPath :: AbsPath → PathAbsolute - _printAbsPath = bimap Py.viewDir Py.viewFile >>> case _ of + _printAbsPath = bimap viewAbsDir viewAbsFile >>> case _ of Left Nil -> PathAbsolute.PathAbsolute Nothing Left (Cons head tail) -> PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ head) @@ -193,46 +198,39 @@ opts = $ (asSegment <$> fromFoldable tail) <> [ asSegment n ] _printRelPath :: RelPath' → PathNoScheme.PathNoScheme - _printRelPath = bimap Py.viewDirUnsandboxed Py.viewFileUnsandboxed >>> case _ of + _printRelPath = bimap viewRelDir viewRelFile >>> case _ of Left Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString "./") [] Left (Cons head tail) -> PathNoScheme.PathNoScheme - $ Tuple (unsafeSegmentNZNCFromString $ maybe "../" Py.runName head) - $ (segmentFromString <<< maybe "../" Py.runName <$> fromFoldable tail) <> [ segmentFromString "" ] + $ Tuple (unsafeSegmentNZNCFromString $ maybe "../" runName head) + $ (segmentFromString <<< maybe "../" runName <$> fromFoldable tail) <> [ segmentFromString "" ] Right (Tuple d n) -> case d of - Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ Py.runName n) [] + Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ runName n) [] Cons head tail -> PathNoScheme.PathNoScheme - $ Tuple (unsafeSegmentNZNCFromString $ maybe "../" Py.runName head) - $ (segmentFromString <<< maybe "../" Py.runName <$> fromFoldable tail) <> [ asSegment n ] + $ Tuple (unsafeSegmentNZNCFromString $ maybe "../" runName head) + $ (segmentFromString <<< maybe "../" runName <$> fromFoldable tail) <> [ asSegment n ] parseAbsSandboxedPath :: String -> Either URIPartParseError AbsPath - parseAbsSandboxedPath = - Py.parsePath + parseAbsSandboxedPath = + Py.parsePath posixParser (const Nothing) - (map Left <<< sandbox) - (const Nothing) - (map Right <<< sandbox) + (Just <<< Left) (const Nothing) - >>> maybe (Left $ URIPartParseError "got invalid path") Right + (Just <<< Right) + Nothing + >>> note (URIPartParseError "got invalid path") parseRelUnsandboxedPath :: String -> Either URIPartParseError RelPath' - parseRelUnsandboxedPath = - Py.parsePath + parseRelUnsandboxedPath = + Py.parsePath posixParser (Just <<< Left) (const Nothing) (Just <<< Right) (const Nothing) - (const Nothing) - >>> maybe (Left $ URIPartParseError "got invalid path") Right - - sandbox - :: forall b s - . SplitDirOrFile b - => Py.Path Py.Abs b s - -> Maybe (Py.Path Py.Abs b Py.Sandboxed) - sandbox p = Py.appendPath Py.rootDir <$> Py.sandbox Py.rootDir p + Nothing + >>> note (URIPartParseError "got invalid path") printScheme :: URI.Scheme -> String @@ -265,7 +263,32 @@ union union r1 r2 = Builder.build (Builder.merge r2) r1 asSegmentNZ :: forall a. Py.Name a -> PathSegmentNZ -asSegmentNZ = Py.runName >>> unsafeSegmentNZFromString +asSegmentNZ = runName >>> unsafeSegmentNZFromString asSegment :: forall a. Py.Name a -> PathSegment -asSegment = Py.runName >>> segmentFromString +asSegment = runName >>> segmentFromString + +runName :: forall a. Py.Name a -> String +runName = un Py.Name >>> NES.toString + +viewAbsDir :: Py.Path Py.Abs Py.Dir -> List (Py.Name Py.Dir) +viewAbsDir = reverse <<< go + where + go p = foldPath Nil + (\_ -> unsafeCrashWith "ParentOf node in viewDir") + (flip Cons <<< go) p + +viewAbsFile :: Py.Path Py.Abs Py.File -> Tuple (List (Py.Name Py.Dir)) (Py.Name Py.File) +viewAbsFile = Py.peelFile >>> lmap viewAbsDir + + +viewRelDir :: Py.Path Py.Rel Py.Dir -> List (Maybe (Py.Name Py.Dir)) +viewRelDir = reverse <<< go + where + go p' = foldPath Nil + (\p -> Cons Nothing (go p)) + (\p n -> Cons (Just n) (go p)) p' + +viewRelFile :: Py.Path Py.Rel Py.File -> Tuple (List (Maybe (Py.Name Py.Dir))) (Py.Name Py.File) +viewRelFile = Py.peelFile >>> lmap viewRelDir + diff --git a/src/Quasar/FS/Mount.purs b/src/Quasar/FS/Mount.purs index 96a8ae8..cd1574b 100644 --- a/src/Quasar/FS/Mount.purs +++ b/src/Quasar/FS/Mount.purs @@ -20,16 +20,18 @@ import Prelude import Control.Alt ((<|>)) import Data.Argonaut (Json, decodeJson, (.?)) +import Data.Bifunctor (bimap) import Data.Const (Const(..)) -import Data.Either (Either(..)) +import Data.Either (Either(..), note) import Data.Eq (class Eq1, eq1) import Data.Identity (Identity(..)) -import Data.Maybe (Maybe, maybe) +import Data.Maybe (Maybe) import Data.Newtype (unwrap) import Data.Ord (class Ord1, compare1) -import Data.Path.Pathy (Dir, File, Name, dir, file, pathName, ()) import Data.String.NonEmpty (fromString) import Data.TacitString as TS +import Pathy (Dir, File, Name(..), dir', file', fileName, name, ()) + import Quasar.Types (AnyPath, DirPath, FilePath) data MountF f @@ -118,14 +120,14 @@ fromJSON parent = decodeJson >=> \obj → do mount ← obj .? "mount" typ ← obj .? "type" name' ← obj .? "name" - name <- maybe (Left "empty name") Right $ fromString name' + name <- note "empty name" $ fromString name' let err :: forall a. Either String a err = Left $ "Unexpected type '" <> typ <> "' for mount '" <> mount <> "'" onFile :: Either String (Identity FilePath) - onFile = if typ == "file" then Right $ Identity $ parent file name else err + onFile = if typ == "file" then Right $ Identity $ parent file' (Name name) else err onDir :: Either String (Identity DirPath) - onDir = if typ == "directory" then Right $ Identity $ parent dir name else err + onDir = if typ == "directory" then Right $ Identity $ parent dir' (Name name) else err onAnyPath :: Either String (Identity AnyPath) onAnyPath = map (map Left) onDir <|> map (map Right) onFile case typeFromName mount of @@ -146,7 +148,7 @@ getPath ∷ Mount → AnyPath getPath = foldPath Left Right getName ∷ Mount → Either (Maybe (Name Dir)) (Name File) -getName = getPath >>> pathName +getName = getPath >>> bimap name fileName typeFromName ∷ String → MountType typeFromName = case _ of diff --git a/src/Quasar/FS/Resource.purs b/src/Quasar/FS/Resource.purs index 95fbc9a..b77a551 100644 --- a/src/Quasar/FS/Resource.purs +++ b/src/Quasar/FS/Resource.purs @@ -20,10 +20,11 @@ import Prelude import Control.Alt ((<|>)) import Data.Argonaut (Json, decodeJson, (.?)) -import Data.Either (Either(..)) -import Data.Maybe (Maybe, maybe) -import Data.Path.Pathy (Dir, File, Name, dir, file, pathName, ()) +import Data.Bifunctor (bimap) +import Data.Either (Either(..), note) +import Data.Maybe (Maybe) import Data.String.NonEmpty (fromString) +import Pathy (Dir, File, Name(..), dir', file', fileName, name, ()) import Quasar.FS.Mount as Mount import Quasar.Types (AnyPath, FilePath, DirPath) @@ -45,11 +46,10 @@ fromJSON parent json = Mount <$> Mount.fromJSON parent json <|> do obj ← decodeJson json - name' ← obj .? "name" - name <- maybe (Left "empty name") Right $ fromString name' + name' ← note "empty name" <<< fromString =<< (obj .? "name") obj .? "type" >>= case _ of - "directory" → Right $ Directory (parent dir name) - "file" → Right $ File (parent file name) + "directory" → Right $ Directory (parent dir' (Name name')) + "file" → Right $ File (parent file' (Name name')) typ → Left $ "unknown resource type " <> typ getPath ∷ QResource → AnyPath @@ -58,4 +58,4 @@ getPath (Directory p) = Left p getPath (Mount m) = Mount.getPath m getName ∷ QResource → Either (Maybe (Name Dir)) (Name File) -getName = pathName <<< getPath +getName = bimap name fileName <<< getPath diff --git a/src/Quasar/Internal.purs b/src/Quasar/Internal.purs deleted file mode 100644 index fc68da7..0000000 --- a/src/Quasar/Internal.purs +++ /dev/null @@ -1,24 +0,0 @@ -module Quasar.Internal where - -import Data.Path.Pathy (RelDir, RelFile, Sandboxed, file, dir) -import Data.String.NonEmpty (NonEmptyString) -import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) -import Type.Data.Boolean (False) -import Type.Data.Symbol (class Equals) -import Unsafe.Coerce (unsafeCoerce) - -class IsSymbolNonEmpty sym where - reflectNonEmpty :: SProxy sym -> NonEmptyString - -instance isSymbolNonEmpty :: (IsSymbol s, Equals s "" False) => IsSymbolNonEmpty s where - reflectNonEmpty _ = asNonEmpty (reflectSymbol (SProxy :: SProxy s)) - where - asNonEmpty :: String -> NonEmptyString - asNonEmpty = unsafeCoerce - - -file_ :: forall s. IsSymbolNonEmpty s => SProxy s → RelFile Sandboxed -file_ x = file (reflectNonEmpty x) - -dir_ :: forall s. IsSymbolNonEmpty s => SProxy s → RelDir Sandboxed -dir_ x = dir (reflectNonEmpty x) diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index 0ed9787..c18e735 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -29,7 +29,7 @@ import Data.Char.Gen as CG import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) -import Data.Path.Pathy.Gen (genAbsDirPath, genAbsFilePath) as PGen +import Pathy.Gen (genAbsDirPath, genAbsFilePath) as PGen import Data.String as S import Data.String.Gen as SG import Data.String.NonEmpty (NonEmptyString, cons) diff --git a/src/Quasar/Mount/Couchbase.purs b/src/Quasar/Mount/Couchbase.purs index 309bcdf..815d41a 100644 --- a/src/Quasar/Mount/Couchbase.purs +++ b/src/Quasar/Mount/Couchbase.purs @@ -30,12 +30,12 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Newtype (un) import Data.Number as Num -import Data.Path.Pathy (()) -import Data.Path.Pathy as P import Data.StrMap as SM import Data.String.NonEmpty (NonEmptyString) import Data.Time.Duration (Seconds(..)) import Data.Tuple (Tuple(..)) +import Pathy (Name(..), ()) +import Pathy as P import Quasar.Data.URI as URI import Text.Parsing.Parser (runParser) @@ -73,7 +73,7 @@ toURI { host, bucketName, password, docTypeKey, queryTimeout } = authority (case bucketName of Nothing -> Just $ Left P.rootDir - Just n -> Just $ Right $ P.rootDir P.file n + Just n -> Just $ Right $ P.rootDir P.file' (Name n) ) authority :: URI.QAuthority diff --git a/src/Quasar/Mount/Mimir.purs b/src/Quasar/Mount/Mimir.purs index 3240ade..7ae64b2 100644 --- a/src/Quasar/Mount/Mimir.purs +++ b/src/Quasar/Mount/Mimir.purs @@ -18,39 +18,25 @@ module Quasar.Mount.Mimir ( Config , toJSON , fromJSON - , parseDirPath ) where import Prelude import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) -import Data.Either (Either(..)) -import Data.Maybe (Maybe, maybe) -import Data.Path.Pathy (class SplitDirOrFile, Abs, Dir, Path, Sandboxed, Unsandboxed, ()) -import Data.Path.Pathy as P +import Data.Either (Either, note) +import Pathy (Abs, Dir, Path) +import Quasar.Types (parseQDirPath, printQPath) -type Config = Path Abs Dir Sandboxed - -sandbox - ∷ forall a - . SplitDirOrFile a - ⇒ Path Abs a Unsandboxed - → Maybe (Path Abs a Sandboxed) -sandbox = - map (P.rootDir _) <<< P.sandbox P.rootDir - -parseDirPath ∷ String -> Maybe (Path Abs Dir Sandboxed) -parseDirPath = sandbox <=< P.parseAbsDir +type Config = Path Abs Dir toJSON ∷ Config → Json toJSON config = - let uri = P.printPath config - in "mimir" := ("connectionUri" := uri ~> jsonEmptyObject) ~> jsonEmptyObject + "mimir" := ("connectionUri" := printQPath config ~> jsonEmptyObject) ~> jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON - = maybe (Left "Couldn't sandbox") Right - <<< parseDirPath + = note "Couldn't parse absolute dir path" + <<< parseQDirPath <=< (_ .? "connectionUri") <=< (_ .? "mimir") <=< decodeJson diff --git a/src/Quasar/Mount/MongoDB.purs b/src/Quasar/Mount/MongoDB.purs index 12a2431..d4f5842 100644 --- a/src/Quasar/Mount/MongoDB.purs +++ b/src/Quasar/Mount/MongoDB.purs @@ -32,7 +32,7 @@ import Data.Either (Either(..)) import Data.Foldable (null) import Data.Maybe (Maybe(..), maybe) import Data.Newtype (class Newtype, unwrap) -import Data.Path.Pathy as P +import Pathy as P import Data.StrMap as SM import Quasar.Data.URI as URI import Quasar.Types (AnyPath) diff --git a/src/Quasar/Mount/SparkHDFS.purs b/src/Quasar/Mount/SparkHDFS.purs index d8670fc..1f40438 100644 --- a/src/Quasar/Mount/SparkHDFS.purs +++ b/src/Quasar/Mount/SparkHDFS.purs @@ -27,14 +27,13 @@ import Prelude import Data.Argonaut (Json, (.?), (:=), (~>)) import Data.Argonaut as J import Data.Bifunctor (lmap) -import Data.Either (Either(..)) +import Data.Either (Either(..), note) import Data.Maybe (Maybe(..), maybe) -import Data.Path.Pathy (parseAbsDir, printPath, rootDir, sandbox, ()) import Data.StrMap as SM import Data.Tuple (Tuple(..)) import Global (encodeURIComponent, decodeURIComponent) import Quasar.Data.URI as URI -import Quasar.Types (DirPath) +import Quasar.Types (DirPath, parseQDirPath, printQPath) import Text.Parsing.Parser (runParser) type Config = @@ -64,7 +63,7 @@ toURI cfg = requiredProps ∷ Array (Tuple String (Maybe String)) requiredProps = [ Tuple "hdfsUrl" $ Just $ encodeURIComponent $ URI.qAbsoluteURI.print $ mkURI hdfsURIScheme cfg.hdfsHost Nothing - , Tuple "rootPath" $ Just $ printPath cfg.path + , Tuple "rootPath" $ Just $ printQPath cfg.path ] optionalProps ∷ Array (Tuple String (Maybe String)) @@ -85,9 +84,7 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ spark Tuple path props'' ← case SM.pop "rootPath" props' of Just (Tuple (Just value) rest) → do - dirPath ← case parseAbsDir value >>= sandbox rootDir of - Just dp → pure $ rootDir dp - Nothing → Left "Expected `rootPath` to be a directory path" + dirPath ← note "Expected `rootPath` to be a directory path" $ parseQDirPath value pure (Tuple dirPath rest) _ → Left "Expected `rootPath` query parameter" diff --git a/src/Quasar/Mount/SparkLocal.purs b/src/Quasar/Mount/SparkLocal.purs index cac42e2..ee313f0 100644 --- a/src/Quasar/Mount/SparkLocal.purs +++ b/src/Quasar/Mount/SparkLocal.purs @@ -18,39 +18,24 @@ module Quasar.Mount.SparkLocal ( Config , toJSON , fromJSON - , parseDirPath ) where import Prelude import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) -import Data.Either (Either(..)) -import Data.Maybe (Maybe, maybe) -import Data.Path.Pathy (class SplitDirOrFile, Abs, Dir, Path, Sandboxed, Unsandboxed, ()) -import Data.Path.Pathy as P +import Data.Either (Either, note) +import Quasar.Types (DirPath, parseQDirPath, printQPath) -type Config = Path Abs Dir Sandboxed - -sandbox - ∷ forall a - . SplitDirOrFile a - => Path Abs a Unsandboxed - → Maybe (Path Abs a Sandboxed) -sandbox = - map (P.rootDir _) <<< P.sandbox P.rootDir - -parseDirPath ∷ String -> Maybe (Path Abs Dir Sandboxed) -parseDirPath = sandbox <=< P.parseAbsDir +type Config = DirPath toJSON ∷ Config → Json toJSON config = - let uri = P.printPath config - in "spark-local" := ("connectionUri" := uri ~> jsonEmptyObject) ~> jsonEmptyObject + "spark-local" := ("connectionUri" := printQPath config ~> jsonEmptyObject) ~> jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON - = maybe (Left "Couldn't sandbox") Right - <<< parseDirPath + = note "Couldn't parse absolute dir path" + <<< parseQDirPath <=< (_ .? "connectionUri") <=< (_ .? "spark-local") <=< decodeJson diff --git a/src/Quasar/Mount/View.purs b/src/Quasar/Mount/View.purs index 9296f20..0ca0c81 100644 --- a/src/Quasar/Mount/View.purs +++ b/src/Quasar/Mount/View.purs @@ -20,7 +20,7 @@ import Prelude import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (~>), (:=)) import Data.Bifunctor (bimap, lmap) -import Data.Either (Either(..)) +import Data.Either (Either(..), note) import Data.Foldable (foldMap) import Data.Maybe (Maybe(..), maybe) import Data.StrMap as SM @@ -67,7 +67,7 @@ fromURI ∷ URI.QAbsoluteURI → Either String Config fromURI (URI.AbsoluteURI scheme _ query) = do unless (scheme == uriScheme) $ Left "Expected 'sql2' URL scheme" let queryMap = maybe [] (\(URI.QueryPairs q) → q) query - query' ← maybe (Left "Expected 'q' query variable") pure (extractQuery queryMap) + query' ← note "Expected 'q' query variable" $ extractQuery queryMap q ← Sql.parseQuery query' # lmap \(ParseError err (Position { line , column })) → "Expected 'q' query variable to contain valid query, " <> "but at line " <> show line <> "and column " <> show column <> " got parse error: \n" <> err diff --git a/src/Quasar/Paths.purs b/src/Quasar/Paths.purs index 26589ad..b8f5a5b 100644 --- a/src/Quasar/Paths.purs +++ b/src/Quasar/Paths.purs @@ -16,33 +16,32 @@ limitations under the License. module Quasar.Paths where -import Data.Path.Pathy (RelDir, RelFile, Sandboxed, ()) +import Pathy (RelDir, RelFile, file, dir, ()) import Data.Symbol (SProxy(..)) -import Quasar.Internal (file_, dir_) -upload ∷ RelFile Sandboxed -upload = file_ (SProxy :: SProxy "upload") +upload ∷ RelFile +upload = file (SProxy :: SProxy "upload") -metadata ∷ RelDir Sandboxed -metadata = dir_ (SProxy :: SProxy "metadata") dir_ (SProxy :: SProxy "fs") +metadata ∷ RelDir +metadata = dir (SProxy :: SProxy "metadata") dir (SProxy :: SProxy "fs") -metastore ∷ RelFile Sandboxed -metastore = file_ (SProxy :: SProxy "metastore") +metastore ∷ RelFile +metastore = file (SProxy :: SProxy "metastore") -mount ∷ RelDir Sandboxed -mount = dir_ (SProxy :: SProxy "mount") dir_ (SProxy :: SProxy "fs") +mount ∷ RelDir +mount = dir (SProxy :: SProxy "mount") dir (SProxy :: SProxy "fs") -data_ ∷ RelDir Sandboxed -data_ = dir_ (SProxy :: SProxy "data") dir_ (SProxy :: SProxy "fs") +data_ ∷ RelDir +data_ = dir (SProxy :: SProxy "data") dir (SProxy :: SProxy "fs") -query ∷ RelDir Sandboxed -query = dir_ (SProxy :: SProxy "query") dir_ (SProxy :: SProxy "fs") +query ∷ RelDir +query = dir (SProxy :: SProxy "query") dir (SProxy :: SProxy "fs") -compile ∷ RelDir Sandboxed -compile = dir_ (SProxy :: SProxy "compile") dir_ (SProxy :: SProxy "fs") +compile ∷ RelDir +compile = dir (SProxy :: SProxy "compile") dir (SProxy :: SProxy "fs") -serverInfo ∷ RelFile Sandboxed -serverInfo = dir_ (SProxy :: SProxy "server") file_ (SProxy :: SProxy "info") +serverInfo ∷ RelFile +serverInfo = dir (SProxy :: SProxy "server") file (SProxy :: SProxy "info") -invoke ∷ RelDir Sandboxed -invoke = dir_ (SProxy :: SProxy "invoke") dir_ (SProxy :: SProxy "fs") +invoke ∷ RelDir +invoke = dir (SProxy :: SProxy "invoke") dir (SProxy :: SProxy "fs") diff --git a/src/Quasar/QuasarF/Interpreter/Affjax.purs b/src/Quasar/QuasarF/Interpreter/Affjax.purs index 9c4410b..63f3f31 100644 --- a/src/Quasar/QuasarF/Interpreter/Affjax.purs +++ b/src/Quasar/QuasarF/Interpreter/Affjax.purs @@ -37,13 +37,15 @@ import Data.Int as Int import Data.Maybe (Maybe(..)) import Data.MediaType.Common (applicationJSON) import Data.Monoid (mempty) -import Data.Path.Pathy (absolutify, peel, printPath, rootDir, runName, sandbox) +import Data.Newtype (un) import Data.StrMap as SM +import Data.String.NonEmpty (toString) import Data.Time.Duration (Seconds(..)) import Data.Tuple (Tuple(..), fst, snd) import Network.HTTP.Affjax.Request (RequestContent, toRequest) import Network.HTTP.AffjaxF as AXF import Network.HTTP.RequestHeader as Req +import Pathy (Name(..), peel, rootDir) import Quasar.ConfigF as CF import Quasar.Data.Json as Json import Quasar.Data.MediaTypes (applicationZip) @@ -57,6 +59,7 @@ import Quasar.QuasarF.Interpreter.Config (Config) import Quasar.QuasarF.Interpreter.Internal (defaultRequest, delete, get, jsonResult, mkFSUrl, mkRequest, mkUrl, put, strResult, toPageParams, toVarParams, unitResult) import Quasar.Query.OutputMeta as QueryOutputMeta import Quasar.ServerInfo as ServerInfo +import Quasar.Types (printQPath) import Quasar.Types as QT import SqlSquared as Sql @@ -86,7 +89,7 @@ eval = case _ of }) WriteQuery path file sql vars k → do - let destHeader = Tuple "Destination" (printPath file) + let destHeader = Tuple "Destination" (printQPath file) url ← mkFSUrl Paths.query (Left path) (headerParams [destHeader] <> toVarParams vars) k <$> mkRequest writeQueryResult (AXF.affjax $ defaultRequest @@ -153,7 +156,7 @@ eval = case _ of k <$> (mkRequest unitResult <<< delete =<< mkFSUrl Paths.data_ path mempty) MoveData fromPath toPath k → do - let destHeader = Tuple "Destination" (either printPath printPath toPath) + let destHeader = Tuple "Destination" (either printQPath printQPath toPath) url ← mkFSUrl Paths.data_ fromPath (headerParams [destHeader]) k <$> mkRequest unitResult (AXF.affjax defaultRequest @@ -166,16 +169,10 @@ eval = case _ of -- TODO simplify this Tuple parentDir name = case bitraverse peel peel path of Nothing -> Tuple rootDir "" - Just (Left (Tuple parentDir name)) -> case sandbox rootDir parentDir of - Nothing -> - Tuple rootDir "" - Just spd -> - Tuple (absolutify spd) (runName name) - Just (Right (Tuple parentDir name)) -> case sandbox rootDir parentDir of - Nothing -> - Tuple rootDir "" - Just spd -> - Tuple (absolutify spd) (runName name) + Just (Left (Tuple parentDir name)) -> + Tuple parentDir (toString $ un Name name) + Just (Right (Tuple parentDir name)) -> + Tuple parentDir (toString $ un Name name) url ← mkFSUrl Paths.mount (Left parentDir) (headerParams [Tuple "X-File-Name" name]) k <$> mkRequest unitResult (AXF.affjax defaultRequest diff --git a/src/Quasar/QuasarF/Interpreter/Config.purs b/src/Quasar/QuasarF/Interpreter/Config.purs index a887db3..898d95d 100644 --- a/src/Quasar/QuasarF/Interpreter/Config.purs +++ b/src/Quasar/QuasarF/Interpreter/Config.purs @@ -18,10 +18,10 @@ module Quasar.QuasarF.Interpreter.Config where import Data.Either (Either) import Data.Maybe (Maybe) -import Data.Path.Pathy (AbsDir, RelDir, Sandboxed, Unsandboxed) +import Pathy (AbsDir, RelDir) import Quasar.Data.URI as URI -type AbsBasePath = { scheme ∷ URI.Scheme, authority ∷ Maybe URI.QAuthority, path ∷ AbsDir Sandboxed } -type BasePath = Either AbsBasePath (RelDir Unsandboxed) +type AbsBasePath = { scheme ∷ URI.Scheme, authority ∷ Maybe URI.QAuthority, path ∷ AbsDir } +type BasePath = Either AbsBasePath RelDir type Config r = { basePath ∷ BasePath | r } diff --git a/src/Quasar/QuasarF/Interpreter/Internal.purs b/src/Quasar/QuasarF/Interpreter/Internal.purs index 98d23e9..e6909f0 100644 --- a/src/Quasar/QuasarF/Interpreter/Internal.purs +++ b/src/Quasar/QuasarF/Interpreter/Internal.purs @@ -44,8 +44,6 @@ import Data.Functor.Coproduct (Coproduct, left, right) import Data.HTTP.Method (Method(..)) import Data.Maybe (Maybe(..), fromMaybe) import Data.Monoid (mempty) -import Data.Path.Pathy (class SplitDirOrFile, Abs, AnyPath, Path, Rel, RelDir, RelPath, Sandboxed, Unsandboxed, relativify, ()) - import Data.StrMap as SM import Data.String as Str import Data.Tuple (Tuple(..)) @@ -54,6 +52,7 @@ import Network.HTTP.Affjax.Request (RequestContent) import Network.HTTP.AffjaxF as AXF import Network.HTTP.ResponseHeader as RH import Network.HTTP.StatusCode (StatusCode(..)) +import Pathy (class IsDirOrFile, Abs, AbsPath, Path, Rel, RelDir, RelPath, relativeTo, rootDir, ()) import Quasar.ConfigF as CF import Quasar.Data.URI as URI import Quasar.QuasarF (Pagination, QError(..), PDFError(..), UnauthorizedDetails(..)) @@ -98,29 +97,19 @@ delete u = AXF.affjax (defaultRequest { method = Left DELETE, url = u }) mkFSUrl ∷ ∀ r - . RelDir Sandboxed - → AnyPath Abs Sandboxed + . RelDir + → AbsPath → URI.QQuery → AjaxM r String -mkFSUrl relDir fsPath q = do - uri ← URI.qURIRef.print <$> mkFSUrl' relDir fsPath q - pure uri - -mkFSUrl' - ∷ ∀ r - . RelDir Sandboxed - → AnyPath Abs Sandboxed - → URI.QQuery - → AjaxM r URI.QURIRef -mkFSUrl' relDir fsPath = mkUrl' (bimap baseify baseify fsPath) +mkFSUrl relDir fsPath q = mkUrl (bimap baseify baseify fsPath) q where - baseify ∷ ∀ b. SplitDirOrFile b => Path Abs b Sandboxed → Path Rel b Sandboxed - baseify p = relDir relativify p + baseify ∷ ∀ b. IsDirOrFile b => Path Abs b → Path Rel b + baseify p = relDir p `relativeTo` rootDir -mkUrl ∷ ∀ s r. RelPath Sandboxed → URI.QQuery → AjaxM r String +mkUrl ∷ ∀ s r. RelPath → URI.QQuery → AjaxM r String mkUrl relPath q = URI.qURIRef.print <$> mkUrl' relPath q -mkUrl' ∷ ∀ s r. RelPath Sandboxed → URI.QQuery → AjaxM r URI.QURIRef +mkUrl' ∷ ∀ s r. RelPath → URI.QQuery → AjaxM r URI.QURIRef mkUrl' relPath q = do { basePath } ← ask pure (bimap toURI toRelativeRef basePath) @@ -140,7 +129,7 @@ mkUrl' relPath q = do (if q == mempty then Nothing else Just q) Nothing - toRelativeRef :: RelDir Unsandboxed -> URI.QRelativeRef + toRelativeRef :: RelDir -> URI.QRelativeRef toRelativeRef relDir = URI.RelativeRef (URI.RelativePartNoAuth diff --git a/src/Quasar/Query/OutputMeta.purs b/src/Quasar/Query/OutputMeta.purs index 4b9f048..51d678d 100644 --- a/src/Quasar/Query/OutputMeta.purs +++ b/src/Quasar/Query/OutputMeta.purs @@ -19,11 +19,8 @@ module Quasar.Query.OutputMeta where import Prelude import Data.Argonaut (Json, JArray, decodeJson, (.?)) -import Data.Either (Either(..)) -import Data.Maybe (Maybe, maybe) -import Data.Path.Pathy (parseAbsFile, rootDir, sandbox, ()) - -import Quasar.Types (FilePath) +import Data.Either (Either, note) +import Quasar.Types (FilePath, parseQFilePath) type OutputMeta = { out ∷ FilePath @@ -34,9 +31,6 @@ fromJSON ∷ Json → Either String OutputMeta fromJSON json = do obj ← decodeJson json path ← obj .? "out" - out ← maybe (Left "Could not parse 'out' path") Right $ parsePath path + out ← note "Could not parse 'out' path" $ parseQFilePath path phases ← obj .? "phases" pure { out, phases } - where - parsePath ∷ String -> Maybe FilePath - parsePath = map (rootDir _) <<< sandbox rootDir <=< parseAbsFile diff --git a/src/Quasar/Types.purs b/src/Quasar/Types.purs index a72eaef..8abf88f 100644 --- a/src/Quasar/Types.purs +++ b/src/Quasar/Types.purs @@ -19,18 +19,25 @@ module Quasar.Types where import Prelude import Control.Alt ((<|>)) - import Data.Argonaut (class DecodeJson, decodeJson, (.?), jsonParser) -import Data.Either (Either(..)) -import Data.Maybe (maybe) -import Data.Path.Pathy (AbsPath, AbsFile, AbsDir, Sandboxed, ()) -import Data.Path.Pathy as Pt +import Data.Either (Either(..), note) +import Data.Maybe (Maybe, maybe) import Data.StrMap (StrMap) import Data.Traversable (traverse) +import Pathy (class IsDirOrFile, Abs, AbsPath, Dir, File, Path, parseAbsDir, parseAbsFile, posixParser, posixPrinter, printPath, sandboxAny) + +type AnyPath = AbsPath +type DirPath = Path Abs Dir +type FilePath = Path Abs File + +printQPath :: forall b. IsDirOrFile b => Path Abs b -> String +printQPath = sandboxAny >>> printPath posixPrinter + +parseQFilePath :: String -> Maybe FilePath +parseQFilePath = parseAbsFile posixParser -type AnyPath = AbsPath Sandboxed -type DirPath = AbsDir Sandboxed -type FilePath = AbsFile Sandboxed +parseQDirPath :: String -> Maybe DirPath +parseQDirPath = parseAbsDir posixParser type Vars = StrMap String @@ -54,12 +61,8 @@ instance decodeJsonCompileResult ∷ DecodeJson CompileResult where <*> ((obj .? "physicalPlan") <|> pure "") <#> CompileResult -parseFile ∷ String → Either String (Pt.AbsFile Pt.Sandboxed) -parseFile pt = - Pt.parseAbsFile pt - >>= Pt.sandbox Pt.rootDir - <#> (Pt.rootDir _) - # maybe (Left "Incorrect resource") pure +parseFile ∷ String → Either String FilePath +parseFile = parseQFilePath >>> note "Incorrect resource" compileResultFromString ∷ String → Either String CompileResultR compileResultFromString s = diff --git a/test/src/Test/Main.purs b/test/src/Test/Main.purs index 0c75601..0fa3f49 100644 --- a/test/src/Test/Main.purs +++ b/test/src/Test/Main.purs @@ -34,7 +34,7 @@ import Data.Either (Either(..), isRight) import Data.Foldable (traverse_) import Data.Functor.Coproduct (left) import Data.Maybe (Maybe(..)) -import Data.Path.Pathy (rootDir, dir, file, ()) +import Pathy (rootDir, dir, file, ()) import Data.Posix.Signal (Signal(SIGTERM)) import Data.StrMap as SM import Data.String as Str @@ -53,7 +53,6 @@ import Quasar.Advanced.QuasarAF.Interpreter.Aff (Config, eval) import Quasar.Data (QData(..)) import Quasar.Data.Json as Json import Quasar.Data.URI as URI -import Quasar.Internal (dir_, file_) import Quasar.Mount (MountConfig(..)) import Quasar.QuasarF (QuasarF, QError(..)) import Quasar.QuasarF as QF @@ -212,16 +211,16 @@ main = void $ runAff (const (pure unit)) $ jumpOutOnError do where testDbAnyDir = rootDir - nonexistant = rootDir file_ (SProxy :: SProxy "nonexistant") - testFile1 = rootDir file_ (SProxy :: SProxy "test1") - testFile2Dir = rootDir dir_ (SProxy :: SProxy "subdir") - testFile2 = testFile2Dir file_ (SProxy :: SProxy "test2") - testFile3Dir = rootDir dir_ (SProxy :: SProxy "what") - testFile3 = testFile3Dir file_ (SProxy :: SProxy "test2") - testMount = rootDir file_ (SProxy :: SProxy "testMount") - testMount2 = rootDir file_ (SProxy :: SProxy "testMount2") - testMount3 = rootDir dir_ (SProxy :: SProxy "testMount3") - testProcess = rootDir dir_ (SProxy :: SProxy "testMount3") file_ (SProxy :: SProxy "test") + nonexistant = rootDir file (SProxy :: SProxy "nonexistant") + testFile1 = rootDir file (SProxy :: SProxy "test1") + testFile2Dir = rootDir dir (SProxy :: SProxy "subdir") + testFile2 = testFile2Dir file (SProxy :: SProxy "test2") + testFile3Dir = rootDir dir (SProxy :: SProxy "what") + testFile3 = testFile3Dir file (SProxy :: SProxy "test2") + testMount = rootDir file (SProxy :: SProxy "testMount") + testMount2 = rootDir file (SProxy :: SProxy "testMount2") + testMount3 = rootDir dir (SProxy :: SProxy "testMount3") + testProcess = rootDir dir (SProxy :: SProxy "testMount3") file (SProxy :: SProxy "test") isNotFound ∷ ∀ a. Either QError a → Boolean isNotFound e = case e of From aacdd92c82e8ef278279c6fcda6e23d653e4f385 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 14:14:45 +0400 Subject: [PATCH 05/33] test passes --- src/Quasar/FS/Mount.purs | 7 ++-- src/Quasar/Mount/Common.purs | 46 ---------------------- src/Quasar/Mount/Common/Gen.purs | 14 ++----- src/Quasar/Mount/MongoDB.purs | 1 - src/Quasar/Mount/SparkHDFS.purs | 7 ++-- src/Quasar/QuasarF/Interpreter/Affjax.purs | 16 +++----- test/src/Test/Main.purs | 2 +- 7 files changed, 16 insertions(+), 77 deletions(-) delete mode 100644 src/Quasar/Mount/Common.purs diff --git a/src/Quasar/FS/Mount.purs b/src/Quasar/FS/Mount.purs index cd1574b..514bccf 100644 --- a/src/Quasar/FS/Mount.purs +++ b/src/Quasar/FS/Mount.purs @@ -119,15 +119,14 @@ fromJSON ∷ DirPath → Json → Either String Mount fromJSON parent = decodeJson >=> \obj → do mount ← obj .? "mount" typ ← obj .? "type" - name' ← obj .? "name" - name <- note "empty name" $ fromString name' + name' ← note "empty name" <<< fromString =<< (obj .? "name") let err :: forall a. Either String a err = Left $ "Unexpected type '" <> typ <> "' for mount '" <> mount <> "'" onFile :: Either String (Identity FilePath) - onFile = if typ == "file" then Right $ Identity $ parent file' (Name name) else err + onFile = if typ == "file" then Right $ Identity $ parent file' (Name name') else err onDir :: Either String (Identity DirPath) - onDir = if typ == "directory" then Right $ Identity $ parent dir' (Name name) else err + onDir = if typ == "directory" then Right $ Identity $ parent dir' (Name name') else err onAnyPath :: Either String (Identity AnyPath) onAnyPath = map (map Left) onDir <|> map (map Right) onFile case typeFromName mount of diff --git a/src/Quasar/Mount/Common.purs b/src/Quasar/Mount/Common.purs deleted file mode 100644 index 94732f4..0000000 --- a/src/Quasar/Mount/Common.purs +++ /dev/null @@ -1,46 +0,0 @@ -{- -Copyright 2017 SlamData, Inc. - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. --} - -module Quasar.Mount.Common where - -import Prelude - -import Data.Lens (view) -import Data.Maybe (Maybe(..), fromMaybe) -import Data.Newtype (class Newtype) -import Quasar.Data.URI as URI -import Data.URI.Authority (_userInfo) -import Data.URI.Extra.UserPassInfo (UserPassInfo(..)) - -newtype Credentials = Credentials { user ∷ String, password ∷ String } - -derive instance newtypeCredentials ∷ Newtype Credentials _ -derive instance eqCredentials ∷ Eq Credentials -derive instance ordCredentials ∷ Ord Credentials - -instance showCredentials ∷ Show Credentials where - show (Credentials { user, password }) = - "(Credentials { user: " <> show user <> ", password: " <> show password <> " })" - -combineCredentials ∷ Credentials → UserPassInfo -combineCredentials (Credentials { user, password }) = UserPassInfo { user, password: Just password } - -extractCredentials ∷ ∀ hosts. Maybe (URI.Authority UserPassInfo hosts) → Maybe Credentials -extractCredentials mbAuth = - let - mbUI = mbAuth >>= view _userInfo - in - mbUI <#> (\(UserPassInfo u) -> Credentials u{ password = fromMaybe "" u.password}) diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index c18e735..d7fdca9 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -21,20 +21,20 @@ module Quasar.Mount.Common.Gen import Prelude -import Control.Monad.Gen (class MonadGen) +import Control.Monad.Gen (class MonadGen, filtered) import Control.Monad.Gen as Gen import Control.Monad.Gen.Common as GenC -import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM) +import Control.Monad.Rec.Class (class MonadRec) import Data.Char.Gen as CG import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) -import Pathy.Gen (genAbsDirPath, genAbsFilePath) as PGen import Data.String as S import Data.String.Gen as SG import Data.String.NonEmpty (NonEmptyString, cons) import Data.These (These(..)) import Data.URI.Host.IPv4Address (fromInts) as IPv4Address +import Pathy.Gen (genAbsDirPath, genAbsFilePath) as PGen import Quasar.Data.URI as URI import Quasar.Types (AnyPath) @@ -86,11 +86,3 @@ genCredentials = genAnyPath ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m AnyPath genAnyPath = Gen.oneOf $ (Left <$> PGen.genAbsDirPath) :| [Right <$> PGen.genAbsFilePath] - -filtered :: forall m a. MonadRec m => MonadGen m => m (Maybe a) -> m a -filtered gen = tailRecM go unit - where - go :: Unit -> m (Step Unit a) - go _ = gen <#> \a -> case a of - Nothing -> Loop unit - Just a -> Done a diff --git a/src/Quasar/Mount/MongoDB.purs b/src/Quasar/Mount/MongoDB.purs index d4f5842..150c0d9 100644 --- a/src/Quasar/Mount/MongoDB.purs +++ b/src/Quasar/Mount/MongoDB.purs @@ -50,7 +50,6 @@ instance showAuth ∷ Show Auth where type Config = { hosts ∷ URI.QURIHost - -- { hosts ∷ NonEmpty Array Host , auth ∷ Maybe Auth , props ∷ SM.StrMap (Maybe String) } diff --git a/src/Quasar/Mount/SparkHDFS.purs b/src/Quasar/Mount/SparkHDFS.purs index 1f40438..c4feac5 100644 --- a/src/Quasar/Mount/SparkHDFS.purs +++ b/src/Quasar/Mount/SparkHDFS.purs @@ -90,21 +90,20 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ spark pure { sparkHost, hdfsHost, path, props: props'' } -mkURI :: URI.Scheme -> URI.QURIHost -> Maybe URI.QQuery -> URI.QAbsoluteURI +mkURI ∷ URI.Scheme → URI.QURIHost → Maybe URI.QQuery → URI.QAbsoluteURI mkURI scheme host params = URI.AbsoluteURI (scheme) (URI.HierarchicalPartAuth (URI.Authority Nothing host) Nothing) params - extractHost' ∷ URI.Scheme → String → Either String URI.QURIHost extractHost' scheme uri = do URI.AbsoluteURI scheme' hierPart _ ← lmap show $ runParser uri URI.qAbsoluteURI.parser unless (scheme' == scheme) $ Left $ "Expected '" <> URI.printScheme scheme <> "' URL scheme" case hierPart of - URI.HierarchicalPartNoAuth _ -> Left $ "Expected auth part to be present in URL" - URI.HierarchicalPartAuth (URI.Authority _ host) _ -> pure host + URI.HierarchicalPartNoAuth _ → Left $ "Expected auth part to be present in URL" + URI.HierarchicalPartAuth (URI.Authority _ host) _ → pure host sparkURIScheme ∷ URI.Scheme sparkURIScheme = URI.unsafeSchemaFromString "spark" diff --git a/src/Quasar/QuasarF/Interpreter/Affjax.purs b/src/Quasar/QuasarF/Interpreter/Affjax.purs index 63f3f31..417e48c 100644 --- a/src/Quasar/QuasarF/Interpreter/Affjax.purs +++ b/src/Quasar/QuasarF/Interpreter/Affjax.purs @@ -27,8 +27,7 @@ import Control.Monad.Eff.Exception (Error, error) import Control.Monad.Free (Free) import Data.Argonaut (Json, JObject, jsonEmptyObject, (:=), (~>)) import Data.Array (catMaybes) -import Data.Bifunctor (lmap) -import Data.Bitraversable (bitraverse) +import Data.Bifunctor (bimap, lmap) import Data.Either (Either(..), either) import Data.Foldable (class Foldable, foldl, foldMap) import Data.Functor.Coproduct (Coproduct) @@ -45,7 +44,7 @@ import Data.Tuple (Tuple(..), fst, snd) import Network.HTTP.Affjax.Request (RequestContent, toRequest) import Network.HTTP.AffjaxF as AXF import Network.HTTP.RequestHeader as Req -import Pathy (Name(..), peel, rootDir) +import Pathy (Name(..), peel, peelFile, rootDir) import Quasar.ConfigF as CF import Quasar.Data.Json as Json import Quasar.Data.MediaTypes (applicationZip) @@ -166,13 +165,10 @@ eval = case _ of CreateMount path config mbMaxAge k → do let - -- TODO simplify this - Tuple parentDir name = case bitraverse peel peel path of - Nothing -> Tuple rootDir "" - Just (Left (Tuple parentDir name)) -> - Tuple parentDir (toString $ un Name name) - Just (Right (Tuple parentDir name)) -> - Tuple parentDir (toString $ un Name name) + Tuple parentDir name = case bimap peel peelFile path of + Left Nothing -> Tuple rootDir "" + Left (Just dp) -> dp <#> un Name >>> toString >>> (_ <> "/") + Right fp -> fp <#> un Name >>> toString url ← mkFSUrl Paths.mount (Left parentDir) (headerParams [Tuple "X-File-Name" name]) k <$> mkRequest unitResult (AXF.affjax defaultRequest diff --git a/test/src/Test/Main.purs b/test/src/Test/Main.purs index 0fa3f49..56a81ce 100644 --- a/test/src/Test/Main.purs +++ b/test/src/Test/Main.purs @@ -196,7 +196,7 @@ main = void $ runAff (const (pure unit)) $ jumpOutOnError do log "\nDeleteData (mount):" run isRight $ QF.deleteData (Right testMount2) - log "\nInvokeFile:" + log "\nInvokeFile" run isRight $ QF.createMount (Left testMount3) mountConfig3 run isRight $ QF.invokeFile Json.Precise testProcess (SM.fromFoldable [Tuple "a" "4", Tuple "b" "2"]) Nothing From 53ac539995657a641a403c47fb1c4f45a55acd82 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 15:50:10 +0400 Subject: [PATCH 06/33] fix warnings --- src/Quasar/Advanced/Types.purs | 2 +- src/Quasar/Data/URI.purs | 2 -- src/Quasar/QuasarF/Interpreter/Internal.purs | 4 ++-- src/Quasar/Types.purs | 4 ++-- 4 files changed, 5 insertions(+), 7 deletions(-) diff --git a/src/Quasar/Advanced/Types.purs b/src/Quasar/Advanced/Types.purs index 83e3d53..29360d3 100644 --- a/src/Quasar/Advanced/Types.purs +++ b/src/Quasar/Advanced/Types.purs @@ -6,7 +6,7 @@ import Control.Alt ((<|>)) import Data.Argonaut (class EncodeJson, class DecodeJson, encodeJson, decodeJson, Json, JString, (.?), (:=), (~>), jsonEmptyObject) import Data.Bifunctor (lmap) import Data.Either (Either(..), note) -import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe) +import Data.Maybe (Maybe(..), fromMaybe, isJust) import Data.Newtype as Newtype import Data.String as Str import Data.String.NonEmpty (NonEmptyString, fromString, toString) diff --git a/src/Quasar/Data/URI.purs b/src/Quasar/Data/URI.purs index ecea541..8119f1f 100644 --- a/src/Quasar/Data/URI.purs +++ b/src/Quasar/Data/URI.purs @@ -49,7 +49,6 @@ import Data.List (List(..), reverse) import Data.Maybe (Maybe(..), maybe) import Data.Newtype (un) import Data.Record.Builder as Builder -import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES import Data.Tuple (Tuple(..)) import Data.URI (PathAbsolute, PathRootless, RegName) @@ -83,7 +82,6 @@ import Pathy (foldPath, posixParser) import Pathy as Py import Text.Parsing.Parser (Parser) import Type.Row (class RowListNub, class RowToList) -import Unsafe.Coerce (unsafeCoerce) type AbsPath = Py.AbsPath type RelPath' = Py.RelPath diff --git a/src/Quasar/QuasarF/Interpreter/Internal.purs b/src/Quasar/QuasarF/Interpreter/Internal.purs index e6909f0..b4b7c25 100644 --- a/src/Quasar/QuasarF/Interpreter/Internal.purs +++ b/src/Quasar/QuasarF/Interpreter/Internal.purs @@ -106,10 +106,10 @@ mkFSUrl relDir fsPath q = mkUrl (bimap baseify baseify fsPath) q baseify ∷ ∀ b. IsDirOrFile b => Path Abs b → Path Rel b baseify p = relDir p `relativeTo` rootDir -mkUrl ∷ ∀ s r. RelPath → URI.QQuery → AjaxM r String +mkUrl ∷ ∀ r. RelPath → URI.QQuery → AjaxM r String mkUrl relPath q = URI.qURIRef.print <$> mkUrl' relPath q -mkUrl' ∷ ∀ s r. RelPath → URI.QQuery → AjaxM r URI.QURIRef +mkUrl' ∷ ∀ r. RelPath → URI.QQuery → AjaxM r URI.QURIRef mkUrl' relPath q = do { basePath } ← ask pure (bimap toURI toRelativeRef basePath) diff --git a/src/Quasar/Types.purs b/src/Quasar/Types.purs index 8abf88f..6f8907b 100644 --- a/src/Quasar/Types.purs +++ b/src/Quasar/Types.purs @@ -20,8 +20,8 @@ import Prelude import Control.Alt ((<|>)) import Data.Argonaut (class DecodeJson, decodeJson, (.?), jsonParser) -import Data.Either (Either(..), note) -import Data.Maybe (Maybe, maybe) +import Data.Either (Either, note) +import Data.Maybe (Maybe) import Data.StrMap (StrMap) import Data.Traversable (traverse) import Pathy (class IsDirOrFile, Abs, AbsPath, Dir, File, Path, parseAbsDir, parseAbsFile, posixParser, posixPrinter, printPath, sandboxAny) From 14cf8a253bbe5fc8823d57113de37b546ae73ae6 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 16:00:44 +0400 Subject: [PATCH 07/33] Remove pathy types from Quasar.Types also reuse AbsPath generator from pathy --- src/Quasar/Advanced/QuasarAF.purs | 43 ++++++------ src/Quasar/Advanced/Types.purs | 14 ++-- src/Quasar/FS/DirMetadata.purs | 5 +- src/Quasar/FS/Mount.purs | 35 +++++----- src/Quasar/FS/Mount/Gen.purs | 7 +- src/Quasar/FS/Resource.purs | 11 ++-- src/Quasar/Mount/Common/Gen.purs | 5 -- src/Quasar/Mount/MarkLogic.purs | 4 +- src/Quasar/Mount/MarkLogic/Gen.purs | 5 +- src/Quasar/Mount/MongoDB.purs | 3 +- src/Quasar/Mount/MongoDB/Gen.purs | 5 +- src/Quasar/Mount/SparkHDFS.purs | 5 +- src/Quasar/Mount/SparkLocal.purs | 5 +- src/Quasar/QuasarF.purs | 77 +++++++++++----------- src/Quasar/QuasarF/Interpreter/Affjax.purs | 6 +- src/Quasar/Query/OutputMeta.purs | 5 +- src/Quasar/Types.purs | 14 ++-- 17 files changed, 122 insertions(+), 127 deletions(-) diff --git a/src/Quasar/Advanced/QuasarAF.purs b/src/Quasar/Advanced/QuasarAF.purs index 1ed60ae..31b6a43 100644 --- a/src/Quasar/Advanced/QuasarAF.purs +++ b/src/Quasar/Advanced/QuasarAF.purs @@ -30,6 +30,7 @@ import Data.Foldable (class Foldable, foldMap) import Data.Functor.Coproduct (Coproduct, left, right) import Data.Maybe (Maybe(..)) import Data.Time.Duration (Seconds) +import Pathy (AbsDir, AbsFile, AbsPath) import Quasar.Advanced.Types as QA import Quasar.Data (QData) import Quasar.Data.Json (PrecisionMode(..)) @@ -42,7 +43,7 @@ import Quasar.Mount.View as View import Quasar.QuasarF (QuasarF(..)) import Quasar.Query.OutputMeta (OutputMeta) import Quasar.ServerInfo (ServerInfo) -import Quasar.Types (AnyPath, FilePath, DirPath, Pagination, Vars, CompileResultR) +import Quasar.Types (Pagination, Vars, CompileResultR) import SqlSquared (SqlQuery) data QuasarAF a @@ -80,7 +81,7 @@ serverInfo = readQuery ∷ PrecisionMode - → DirPath + → AbsDir → SqlQuery → Vars → Maybe Pagination @@ -89,7 +90,7 @@ readQuery mode path sql vars pagination = left $ ReadQuery mode path sql vars pagination id readQueryEJson - ∷ DirPath + ∷ AbsDir → SqlQuery → Vars → Maybe Pagination @@ -98,8 +99,8 @@ readQueryEJson path sql vars pagination = readQuery Precise path sql vars pagination <#> resultsAsEJson writeQuery - ∷ DirPath - → FilePath + ∷ AbsDir + → AbsFile → SqlQuery → Vars → QuasarAFCE OutputMeta @@ -107,7 +108,7 @@ writeQuery path file sql vars = left $ WriteQuery path file sql vars id compileQuery - ∷ DirPath + ∷ AbsDir → SqlQuery → Vars → QuasarAFCE CompileResultR @@ -115,13 +116,13 @@ compileQuery path sql vars = left $ CompileQuery path sql vars id fileMetadata - ∷ FilePath + ∷ AbsFile → QuasarAFCE Unit fileMetadata path = left $ FileMetadata path id dirMetadata - ∷ DirPath + ∷ AbsDir → Maybe Pagination → QuasarAFCE (Array QResource) dirMetadata path pagination = @@ -129,75 +130,75 @@ dirMetadata path pagination = readFile ∷ PrecisionMode - → FilePath + → AbsFile → Maybe Pagination → QuasarAFCE JArray readFile mode path pagination = left $ ReadFile mode path pagination id readFileEJson - ∷ FilePath + ∷ AbsFile → Maybe Pagination → QuasarAFCE (Array EJson) readFileEJson path pagination = readFile Precise path pagination <#> resultsAsEJson writeFile - ∷ FilePath + ∷ AbsFile → QData → QuasarAFCE Unit writeFile path content = left $ WriteFile path content id writeDir - ∷ DirPath + ∷ AbsDir → Blob → QuasarAFCE Unit writeDir path content = left $ WriteDir path content id appendFile - ∷ FilePath + ∷ AbsFile → QData → QuasarAFCE Unit appendFile path content = left $ AppendFile path content id deleteData - ∷ AnyPath + ∷ AbsPath → QuasarAFCE Unit deleteData path = left $ DeleteData path id moveData - ∷ AnyPath - → AnyPath + ∷ AbsPath + → AbsPath → QuasarAFCE Unit moveData from to = left $ MoveData from to id getMount - ∷ AnyPath + ∷ AbsPath → QuasarAFCE MountConfig getMount path = left $ GetMount path id createMount - ∷ AnyPath + ∷ AbsPath → MountConfig → QuasarAFCE Unit createMount path config = left $ CreateMount path config Nothing id updateMount - ∷ AnyPath + ∷ AbsPath → MountConfig → QuasarAFCE Unit updateMount path config = left $ UpdateMount path config Nothing id createCachedView - ∷ AnyPath + ∷ AbsPath → View.Config → Seconds → QuasarAFCE Unit @@ -205,7 +206,7 @@ createCachedView path config maxAge = left $ CreateMount path (ViewConfig config) (Just maxAge) id updateCachedView - ∷ AnyPath + ∷ AbsPath → View.Config → Seconds → QuasarAFCE Unit diff --git a/src/Quasar/Advanced/Types.purs b/src/Quasar/Advanced/Types.purs index 29360d3..699f076 100644 --- a/src/Quasar/Advanced/Types.purs +++ b/src/Quasar/Advanced/Types.purs @@ -13,10 +13,10 @@ import Data.String.NonEmpty (NonEmptyString, fromString, toString) import Data.Traversable (traverse) import OIDC.Crypt.JSONWebKey (JSONWebKey) import OIDC.Crypt.Types (Issuer(..), ClientId(..)) -import Pathy (rootDir) -import Quasar.Types (DirPath, FilePath, parseQDirPath, parseQFilePath, printQPath) +import Pathy (AbsDir, AbsFile, rootDir) +import Quasar.Types (parseQDirPath, parseQFilePath, printQPath) -newtype GroupPath = GroupPath DirPath +newtype GroupPath = GroupPath AbsDir derive instance eqGroupPath ∷ Eq GroupPath derive instance ordGroupPath ∷ Ord GroupPath @@ -84,8 +84,8 @@ instance decodeJsonAccessType ∷ DecodeJson AccessType where data QResource - = File FilePath - | Dir DirPath + = File AbsFile + | Dir AbsDir | Group GroupPath derive instance eqQResource ∷ Eq QResource @@ -113,10 +113,10 @@ instance decodeJsonQResource ∷ DecodeJson QResource where <|> (map Dir $ lmap (const $ "Incorrect directory resource") $ parseDir pt) -parseFile ∷ String → Either String FilePath +parseFile ∷ String → Either String AbsFile parseFile = parseQFilePath >>> note "Incorrect resource" -parseDir ∷ String → Either String DirPath +parseDir ∷ String → Either String AbsDir parseDir = parseQDirPath >>> note "Incorrect resource" diff --git a/src/Quasar/FS/DirMetadata.purs b/src/Quasar/FS/DirMetadata.purs index 0661420..c6835e4 100644 --- a/src/Quasar/FS/DirMetadata.purs +++ b/src/Quasar/FS/DirMetadata.purs @@ -24,14 +24,13 @@ import Prelude import Data.Argonaut (Json, decodeJson, (.?)) import Data.Either (Either) import Data.Traversable (traverse) - +import Pathy (AbsDir) import Quasar.FS.Resource (QResource) import Quasar.FS.Resource as QResource -import Quasar.Types (DirPath) type DirMetadata = Array QResource -fromJSON ∷ DirPath → Json → Either String DirMetadata +fromJSON ∷ AbsDir → Json → Either String DirMetadata fromJSON parent json = do obj ← decodeJson json children ← obj .? "children" diff --git a/src/Quasar/FS/Mount.purs b/src/Quasar/FS/Mount.purs index 514bccf..0230f54 100644 --- a/src/Quasar/FS/Mount.purs +++ b/src/Quasar/FS/Mount.purs @@ -30,20 +30,19 @@ import Data.Newtype (unwrap) import Data.Ord (class Ord1, compare1) import Data.String.NonEmpty (fromString) import Data.TacitString as TS -import Pathy (Dir, File, Name(..), dir', file', fileName, name, ()) +import Pathy (AbsDir, AbsFile, Dir, File, Name(..), AbsPath, dir', file', fileName, name, ()) -import Quasar.Types (AnyPath, DirPath, FilePath) data MountF f - = View (f FilePath) - | Module (f DirPath) - | MongoDB (f DirPath) - | Couchbase (f DirPath) - | MarkLogic (f DirPath) - | SparkHDFS (f DirPath) - | SparkLocal (f DirPath) - | Mimir (f DirPath) - | Unknown String (f AnyPath) + = View (f AbsFile) + | Module (f AbsDir) + | MongoDB (f AbsDir) + | Couchbase (f AbsDir) + | MarkLogic (f AbsDir) + | SparkHDFS (f AbsDir) + | SparkLocal (f AbsDir) + | Mimir (f AbsDir) + | Unknown String (f AbsPath) type Mount = MountF Identity type MountType = MountF (Const Unit) @@ -115,7 +114,7 @@ instance showMount ∷ (Show (f TS.TacitString), Functor f) ⇒ Show (MountF f) -- | Attempts to decode a mount listing value from Quasar's filesystem metadata, -- | for a mount in the specified parent directory. -fromJSON ∷ DirPath → Json → Either String Mount +fromJSON ∷ AbsDir → Json → Either String Mount fromJSON parent = decodeJson >=> \obj → do mount ← obj .? "mount" typ ← obj .? "type" @@ -123,11 +122,11 @@ fromJSON parent = decodeJson >=> \obj → do let err :: forall a. Either String a err = Left $ "Unexpected type '" <> typ <> "' for mount '" <> mount <> "'" - onFile :: Either String (Identity FilePath) + onFile :: Either String (Identity AbsFile) onFile = if typ == "file" then Right $ Identity $ parent file' (Name name') else err - onDir :: Either String (Identity DirPath) + onDir :: Either String (Identity AbsDir) onDir = if typ == "directory" then Right $ Identity $ parent dir' (Name name') else err - onAnyPath :: Either String (Identity AnyPath) + onAnyPath :: Either String (Identity AbsPath) onAnyPath = map (map Left) onDir <|> map (map Right) onFile case typeFromName mount of View _ → View <$> onFile @@ -140,10 +139,10 @@ fromJSON parent = decodeJson >=> \obj → do Mimir _ → Mimir <$> onDir Unknown n _ → Unknown n <$> onAnyPath -foldPath ∷ ∀ r. (DirPath → r) → (FilePath → r) → Mount → r +foldPath ∷ ∀ r. (AbsDir → r) → (AbsFile → r) → Mount → r foldPath onDir onPath = overPath (onDir >>> Const) (onPath >>> Const) >>> unwrap -getPath ∷ Mount → AnyPath +getPath ∷ Mount → AbsPath getPath = foldPath Left Right getName ∷ Mount → Either (Maybe (Name Dir)) (Name File) @@ -161,7 +160,7 @@ typeFromName = case _ of "mimir" → Mimir $ Const unit other → Unknown other $ Const unit -overPath ∷ ∀ f. Functor f ⇒ (DirPath → f DirPath) → (FilePath → f FilePath) → Mount → f Mount +overPath ∷ ∀ f. Functor f ⇒ (AbsDir → f AbsDir) → (AbsFile → f AbsFile) → Mount → f Mount overPath overDir overFile = case _ of View (Identity file) → overFile file <#> Identity >>> View Module (Identity dir) → overDir dir <#> Identity >>> Module diff --git a/src/Quasar/FS/Mount/Gen.purs b/src/Quasar/FS/Mount/Gen.purs index e5a6bde..b3c62fa 100644 --- a/src/Quasar/FS/Mount/Gen.purs +++ b/src/Quasar/FS/Mount/Gen.purs @@ -19,7 +19,6 @@ module Quasar.FS.Mount.Gen where import Prelude -import Quasar.FS.Mount (MountF(..), Mount, MountType) import Control.Monad.Gen (class MonadGen) import Control.Monad.Gen as Gen import Control.Monad.Rec.Class (class MonadRec) @@ -27,7 +26,9 @@ import Data.Const (Const(..)) import Data.Identity (Identity(..)) import Data.NonEmpty ((:|)) import Data.String.Gen (genUnicodeString) -import Quasar.Mount.Common.Gen (genAnyPath, genAbsDirPath, genAbsFilePath) +import Pathy.Gen (genAbsAnyPath) +import Quasar.FS.Mount (MountF(..), Mount, MountType) +import Quasar.Mount.Common.Gen (genAbsDirPath, genAbsFilePath) genMountType :: ∀ m. MonadGen m ⇒ MonadRec m ⇒ m MountType @@ -53,5 +54,5 @@ genMount = Gen.oneOf , genAbsDirPath <#> Identity >>> SparkHDFS , genAbsDirPath <#> Identity >>> SparkLocal , genAbsDirPath <#> Identity >>> Mimir - , Unknown <$> genUnicodeString <*> map Identity genAnyPath + , Unknown <$> genUnicodeString <*> map Identity genAbsAnyPath ] diff --git a/src/Quasar/FS/Resource.purs b/src/Quasar/FS/Resource.purs index b77a551..8fd2ce1 100644 --- a/src/Quasar/FS/Resource.purs +++ b/src/Quasar/FS/Resource.purs @@ -24,13 +24,12 @@ import Data.Bifunctor (bimap) import Data.Either (Either(..), note) import Data.Maybe (Maybe) import Data.String.NonEmpty (fromString) -import Pathy (Dir, File, Name(..), dir', file', fileName, name, ()) +import Pathy (AbsDir, AbsFile, Dir, File, Name(..), AbsPath, dir', file', fileName, name, ()) import Quasar.FS.Mount as Mount -import Quasar.Types (AnyPath, FilePath, DirPath) data QResource - = File FilePath - | Directory DirPath + = File AbsFile + | Directory AbsDir | Mount Mount.Mount derive instance eqQResource ∷ Eq QResource @@ -41,7 +40,7 @@ instance showQResource ∷ Show QResource where show (Directory p) = "(Directory " <> show p <> ")" show (Mount m) = "(Mount " <> show m <> ")" -fromJSON ∷ DirPath → Json → Either String QResource +fromJSON ∷ AbsDir → Json → Either String QResource fromJSON parent json = Mount <$> Mount.fromJSON parent json <|> do @@ -52,7 +51,7 @@ fromJSON parent json "file" → Right $ File (parent file' (Name name')) typ → Left $ "unknown resource type " <> typ -getPath ∷ QResource → AnyPath +getPath ∷ QResource → AbsPath getPath (File p) = Right p getPath (Directory p) = Left p getPath (Mount m) = Mount.getPath m diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index d7fdca9..bbb3056 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -26,7 +26,6 @@ import Control.Monad.Gen as Gen import Control.Monad.Gen.Common as GenC import Control.Monad.Rec.Class (class MonadRec) import Data.Char.Gen as CG -import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) import Data.String as S @@ -36,7 +35,6 @@ import Data.These (These(..)) import Data.URI.Host.IPv4Address (fromInts) as IPv4Address import Pathy.Gen (genAbsDirPath, genAbsFilePath) as PGen import Quasar.Data.URI as URI -import Quasar.Types (AnyPath) genAlphaNumericString ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m String genAlphaNumericString = SG.genString genAlphaNumericChar @@ -83,6 +81,3 @@ genCredentials = URI.UserPassInfo <$> ({ user: _, password: _ } <$> genAlphaNumericString <*> Gen.choose (pure Nothing) (Just <$> genAlphaNumericString)) - -genAnyPath ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m AnyPath -genAnyPath = Gen.oneOf $ (Left <$> PGen.genAbsDirPath) :| [Right <$> PGen.genAbsFilePath] diff --git a/src/Quasar/Mount/MarkLogic.purs b/src/Quasar/Mount/MarkLogic.purs index 82c330c..85fb856 100644 --- a/src/Quasar/Mount/MarkLogic.purs +++ b/src/Quasar/Mount/MarkLogic.purs @@ -31,13 +31,13 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe) import Data.StrMap as SM import Data.Tuple (Tuple(..)) +import Pathy (AbsPath) import Quasar.Data.URI as URI -import Quasar.Types (AnyPath) import Text.Parsing.Parser (runParser) type Config = { host ∷ URI.QURIHost - , path ∷ Maybe AnyPath + , path ∷ Maybe AbsPath , credentials ∷ Maybe URI.UserPassInfo , format ∷ Format } diff --git a/src/Quasar/Mount/MarkLogic/Gen.purs b/src/Quasar/Mount/MarkLogic/Gen.purs index 60d6eeb..67c2572 100644 --- a/src/Quasar/Mount/MarkLogic/Gen.purs +++ b/src/Quasar/Mount/MarkLogic/Gen.purs @@ -22,7 +22,8 @@ import Control.Monad.Gen (class MonadGen) import Control.Monad.Gen as Gen import Control.Monad.Gen.Common as GenC import Control.Monad.Rec.Class (class MonadRec) -import Quasar.Mount.Common.Gen (genAnyPath, genCredentials, genHost) +import Pathy.Gen (genAbsAnyPath) +import Quasar.Mount.Common.Gen (genCredentials, genHost) import Quasar.Mount.MarkLogic as ML genFormat ∷ ∀ m. MonadGen m ⇒ m ML.Format @@ -32,6 +33,6 @@ genConfig ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m ML.Config genConfig = { host: _, path: _, credentials: _, format: _ } <$> genHost - <*> GenC.genMaybe genAnyPath + <*> GenC.genMaybe genAbsAnyPath <*> GenC.genMaybe genCredentials <*> genFormat diff --git a/src/Quasar/Mount/MongoDB.purs b/src/Quasar/Mount/MongoDB.purs index 150c0d9..d24c526 100644 --- a/src/Quasar/Mount/MongoDB.purs +++ b/src/Quasar/Mount/MongoDB.purs @@ -35,10 +35,9 @@ import Data.Newtype (class Newtype, unwrap) import Pathy as P import Data.StrMap as SM import Quasar.Data.URI as URI -import Quasar.Types (AnyPath) import Text.Parsing.Parser (runParser) -newtype Auth = Auth { path ∷ AnyPath, credentials ∷ URI.UserPassInfo } +newtype Auth = Auth { path ∷ P.AbsPath, credentials ∷ URI.UserPassInfo } derive instance newtypeAuth ∷ Newtype Auth _ derive instance eqAuth ∷ Eq Auth diff --git a/src/Quasar/Mount/MongoDB/Gen.purs b/src/Quasar/Mount/MongoDB/Gen.purs index 7c7b186..c31d714 100644 --- a/src/Quasar/Mount/MongoDB/Gen.purs +++ b/src/Quasar/Mount/MongoDB/Gen.purs @@ -22,7 +22,8 @@ import Control.Monad.Gen (class MonadGen) import Control.Monad.Gen.Common as GenC import Control.Monad.Rec.Class (class MonadRec) import Data.StrMap.Gen as SMG -import Quasar.Mount.Common.Gen (genAlphaNumericString, genHost, genCredentials, genAnyPath) +import Pathy.Gen (genAbsAnyPath) +import Quasar.Mount.Common.Gen (genAlphaNumericString, genHost, genCredentials) import Quasar.Mount.MongoDB as MDB genConfig ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m MDB.Config @@ -36,5 +37,5 @@ genAuth ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m MDB.Auth genAuth = MDB.Auth <$> ({ path: _, credentials: _ } - <$> genAnyPath + <$> genAbsAnyPath <*> genCredentials) diff --git a/src/Quasar/Mount/SparkHDFS.purs b/src/Quasar/Mount/SparkHDFS.purs index c4feac5..40fdbd4 100644 --- a/src/Quasar/Mount/SparkHDFS.purs +++ b/src/Quasar/Mount/SparkHDFS.purs @@ -32,14 +32,15 @@ import Data.Maybe (Maybe(..), maybe) import Data.StrMap as SM import Data.Tuple (Tuple(..)) import Global (encodeURIComponent, decodeURIComponent) +import Pathy (AbsDir) import Quasar.Data.URI as URI -import Quasar.Types (DirPath, parseQDirPath, printQPath) +import Quasar.Types (parseQDirPath, printQPath) import Text.Parsing.Parser (runParser) type Config = { sparkHost ∷ URI.QURIHost , hdfsHost ∷ URI.QURIHost - , path ∷ DirPath + , path ∷ AbsDir , props ∷ SM.StrMap (Maybe String) } diff --git a/src/Quasar/Mount/SparkLocal.purs b/src/Quasar/Mount/SparkLocal.purs index ee313f0..dddba18 100644 --- a/src/Quasar/Mount/SparkLocal.purs +++ b/src/Quasar/Mount/SparkLocal.purs @@ -24,9 +24,10 @@ import Prelude import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Either (Either, note) -import Quasar.Types (DirPath, parseQDirPath, printQPath) +import Pathy (AbsDir) +import Quasar.Types (parseQDirPath, printQPath) -type Config = DirPath +type Config = AbsDir toJSON ∷ Config → Json toJSON config = diff --git a/src/Quasar/QuasarF.purs b/src/Quasar/QuasarF.purs index 3c2e497..a9817ed 100644 --- a/src/Quasar/QuasarF.purs +++ b/src/Quasar/QuasarF.purs @@ -26,6 +26,7 @@ import DOM.File.Types (Blob) import Data.Argonaut (JArray) import Data.Maybe (Maybe(..)) import Data.Time.Duration (Seconds) +import Pathy (AbsDir, AbsFile, AbsPath) import Quasar.Data (QData) import Quasar.Data.Json (PrecisionMode(..)) import Quasar.Data.Json.Extended (EJson, resultsAsEJson) @@ -36,26 +37,26 @@ import Quasar.Mount (MountConfig(..)) import Quasar.Mount.View as View import Quasar.Query.OutputMeta (OutputMeta) import Quasar.ServerInfo (ServerInfo) -import Quasar.Types (AnyPath, FilePath, DirPath, Pagination, Vars, CompileResultR) +import Quasar.Types (Pagination, Vars, CompileResultR) import SqlSquared (SqlQuery) data QuasarF a = ServerInfo (ServerInfo :~> a) - | ReadQuery PrecisionMode DirPath SqlQuery Vars (Maybe Pagination) (JArray :~> a) - | WriteQuery DirPath FilePath SqlQuery Vars (OutputMeta :~> a) - | CompileQuery DirPath SqlQuery Vars (CompileResultR :~> a) - | FileMetadata FilePath (Unit :~> a) - | DirMetadata DirPath (Maybe Pagination) ((Array QResource) :~> a) - | ReadFile PrecisionMode FilePath (Maybe Pagination) (JArray :~> a) - | WriteFile FilePath QData (Unit :~> a) - | WriteDir DirPath Blob (Unit :~> a) - | AppendFile FilePath QData (Unit :~> a) - | InvokeFile PrecisionMode FilePath Vars (Maybe Pagination) (JArray :~> a) - | DeleteData AnyPath (Unit :~> a) - | MoveData AnyPath AnyPath (Unit :~> a) - | GetMount AnyPath (MountConfig :~> a) - | CreateMount AnyPath MountConfig (Maybe Seconds) (Unit :~> a) - | UpdateMount AnyPath MountConfig (Maybe Seconds) (Unit :~> a) + | ReadQuery PrecisionMode AbsDir SqlQuery Vars (Maybe Pagination) (JArray :~> a) + | WriteQuery AbsDir AbsFile SqlQuery Vars (OutputMeta :~> a) + | CompileQuery AbsDir SqlQuery Vars (CompileResultR :~> a) + | FileMetadata AbsFile (Unit :~> a) + | DirMetadata AbsDir (Maybe Pagination) ((Array QResource) :~> a) + | ReadFile PrecisionMode AbsFile (Maybe Pagination) (JArray :~> a) + | WriteFile AbsFile QData (Unit :~> a) + | WriteDir AbsDir Blob (Unit :~> a) + | AppendFile AbsFile QData (Unit :~> a) + | InvokeFile PrecisionMode AbsFile Vars (Maybe Pagination) (JArray :~> a) + | DeleteData AbsPath (Unit :~> a) + | MoveData AbsPath AbsPath (Unit :~> a) + | GetMount AbsPath (MountConfig :~> a) + | CreateMount AbsPath MountConfig (Maybe Seconds) (Unit :~> a) + | UpdateMount AbsPath MountConfig (Maybe Seconds) (Unit :~> a) | GetMetastore (Metastore () :~> a) | PutMetastore { initialize ∷ Boolean, metastore ∷ Metastore (password ∷ String) } (Unit :~> a) @@ -71,7 +72,7 @@ serverInfo = readQuery ∷ PrecisionMode - → DirPath + → AbsDir → SqlQuery → Vars → Maybe Pagination @@ -80,7 +81,7 @@ readQuery mode path sql vars pagination = ReadQuery mode path sql vars pagination id readQueryEJson - ∷ DirPath + ∷ AbsDir → SqlQuery → Vars → Maybe Pagination @@ -89,8 +90,8 @@ readQueryEJson path sql vars pagination = readQuery Precise path sql vars pagination <#> resultsAsEJson writeQuery - ∷ DirPath - → FilePath + ∷ AbsDir + → AbsFile → SqlQuery → Vars → QuasarFE OutputMeta @@ -98,7 +99,7 @@ writeQuery path file sql vars = WriteQuery path file sql vars id compileQuery - ∷ DirPath + ∷ AbsDir → SqlQuery → Vars → QuasarFE CompileResultR @@ -106,13 +107,13 @@ compileQuery path sql vars = CompileQuery path sql vars id fileMetadata - ∷ FilePath + ∷ AbsFile → QuasarFE Unit fileMetadata path = FileMetadata path id dirMetadata - ∷ DirPath + ∷ AbsDir → Maybe Pagination → QuasarFE (Array QResource) dirMetadata path pagination = @@ -120,35 +121,35 @@ dirMetadata path pagination = readFile ∷ PrecisionMode - → FilePath + → AbsFile → Maybe Pagination → QuasarFE JArray readFile mode path pagination = ReadFile mode path pagination id readFileEJson - ∷ FilePath + ∷ AbsFile → Maybe Pagination → QuasarFE (Array EJson) readFileEJson path pagination = readFile Precise path pagination <#> resultsAsEJson writeFile - ∷ FilePath + ∷ AbsFile → QData → QuasarFE Unit writeFile path content = WriteFile path content id writeDir - ∷ DirPath + ∷ AbsDir → Blob → QuasarFE Unit writeDir path content = WriteDir path content id appendFile - ∷ FilePath + ∷ AbsFile → QData → QuasarFE Unit appendFile path content = @@ -156,7 +157,7 @@ appendFile path content = invokeFile ∷ PrecisionMode - → FilePath + → AbsFile → Vars → Maybe Pagination → QuasarFE JArray @@ -164,7 +165,7 @@ invokeFile mode path vars pagination = InvokeFile mode path vars pagination id invokeFileEJson - ∷ FilePath + ∷ AbsFile → Vars → Maybe Pagination → QuasarFE (Array EJson) @@ -172,40 +173,40 @@ invokeFileEJson path vars pagination = invokeFile Precise path vars pagination <#> resultsAsEJson deleteData - ∷ AnyPath + ∷ AbsPath → QuasarFE Unit deleteData path = DeleteData path id moveData - ∷ AnyPath - → AnyPath + ∷ AbsPath + → AbsPath → QuasarFE Unit moveData from to = MoveData from to id getMount - ∷ AnyPath + ∷ AbsPath → QuasarFE MountConfig getMount path = GetMount path id createMount - ∷ AnyPath + ∷ AbsPath → MountConfig → QuasarFE Unit createMount path config = CreateMount path config Nothing id updateMount - ∷ AnyPath + ∷ AbsPath → MountConfig → QuasarFE Unit updateMount path config = UpdateMount path config Nothing id createCachedView - ∷ AnyPath + ∷ AbsPath → View.Config → Seconds → QuasarFE Unit @@ -213,7 +214,7 @@ createCachedView path config maxAge = CreateMount path (ViewConfig config) (Just maxAge) id updateCachedView - ∷ AnyPath + ∷ AbsPath → View.Config → Seconds → QuasarFE Unit diff --git a/src/Quasar/QuasarF/Interpreter/Affjax.purs b/src/Quasar/QuasarF/Interpreter/Affjax.purs index 417e48c..5409b86 100644 --- a/src/Quasar/QuasarF/Interpreter/Affjax.purs +++ b/src/Quasar/QuasarF/Interpreter/Affjax.purs @@ -44,7 +44,7 @@ import Data.Tuple (Tuple(..), fst, snd) import Network.HTTP.Affjax.Request (RequestContent, toRequest) import Network.HTTP.AffjaxF as AXF import Network.HTTP.RequestHeader as Req -import Pathy (Name(..), peel, peelFile, rootDir) +import Pathy (Name(..), AbsDir, peel, peelFile, rootDir) import Quasar.ConfigF as CF import Quasar.Data.Json as Json import Quasar.Data.MediaTypes (applicationZip) @@ -53,7 +53,7 @@ import Quasar.FS.DirMetadata as DirMetadata import Quasar.Metastore as Metastore import Quasar.Mount as Mount import Quasar.Paths as Paths -import Quasar.QuasarF (QuasarF(..), DirPath) +import Quasar.QuasarF (QuasarF(..)) import Quasar.QuasarF.Interpreter.Config (Config) import Quasar.QuasarF.Interpreter.Internal (defaultRequest, delete, get, jsonResult, mkFSUrl, mkRequest, mkUrl, put, strResult, toPageParams, toVarParams, unitResult) import Quasar.Query.OutputMeta as QueryOutputMeta @@ -207,7 +207,7 @@ serverInfoResult = lmap error <$> ServerInfo.fromJSON <=< jsonResult writeQueryResult ∷ String → Either Error QueryOutputMeta.OutputMeta writeQueryResult = lmap error <$> QueryOutputMeta.fromJSON <=< jsonResult -resourcesResult ∷ DirPath → String → Either Error DirMetadata.DirMetadata +resourcesResult ∷ AbsDir → String → Either Error DirMetadata.DirMetadata resourcesResult path = lmap error <$> DirMetadata.fromJSON path <=< jsonResult mountConfigResult ∷ String → Either Error Mount.MountConfig diff --git a/src/Quasar/Query/OutputMeta.purs b/src/Quasar/Query/OutputMeta.purs index 51d678d..fcf344b 100644 --- a/src/Quasar/Query/OutputMeta.purs +++ b/src/Quasar/Query/OutputMeta.purs @@ -20,10 +20,11 @@ import Prelude import Data.Argonaut (Json, JArray, decodeJson, (.?)) import Data.Either (Either, note) -import Quasar.Types (FilePath, parseQFilePath) +import Pathy (AbsFile) +import Quasar.Types (parseQFilePath) type OutputMeta = - { out ∷ FilePath + { out ∷ AbsFile , phases ∷ JArray } diff --git a/src/Quasar/Types.purs b/src/Quasar/Types.purs index 6f8907b..aadd05a 100644 --- a/src/Quasar/Types.purs +++ b/src/Quasar/Types.purs @@ -24,19 +24,15 @@ import Data.Either (Either, note) import Data.Maybe (Maybe) import Data.StrMap (StrMap) import Data.Traversable (traverse) -import Pathy (class IsDirOrFile, Abs, AbsPath, Dir, File, Path, parseAbsDir, parseAbsFile, posixParser, posixPrinter, printPath, sandboxAny) - -type AnyPath = AbsPath -type DirPath = Path Abs Dir -type FilePath = Path Abs File +import Pathy (class IsDirOrFile, Abs, AbsDir, AbsFile, Path, parseAbsDir, parseAbsFile, posixParser, posixPrinter, printPath, sandboxAny) printQPath :: forall b. IsDirOrFile b => Path Abs b -> String printQPath = sandboxAny >>> printPath posixPrinter -parseQFilePath :: String -> Maybe FilePath +parseQFilePath :: String -> Maybe AbsFile parseQFilePath = parseAbsFile posixParser -parseQDirPath :: String -> Maybe DirPath +parseQDirPath :: String -> Maybe AbsDir parseQDirPath = parseAbsDir posixParser type Vars = StrMap String @@ -44,7 +40,7 @@ type Vars = StrMap String type Pagination = { offset ∷ Int, limit ∷ Int } type CompileResultR = - { inputs ∷ Array FilePath + { inputs ∷ Array AbsFile , physicalPlan ∷ String } @@ -61,7 +57,7 @@ instance decodeJsonCompileResult ∷ DecodeJson CompileResult where <*> ((obj .? "physicalPlan") <|> pure "") <#> CompileResult -parseFile ∷ String → Either String FilePath +parseFile ∷ String → Either String AbsFile parseFile = parseQFilePath >>> note "Incorrect resource" compileResultFromString ∷ String → Either String CompileResultR From 7401eed83a893b3b2b3527d789a89e8107ae619a Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 16:45:19 +0400 Subject: [PATCH 08/33] `Incorrect` to `Could not parse` --- src/Quasar/Advanced/Types.purs | 26 +++++++++++++------------- src/Quasar/Types.purs | 2 +- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/Quasar/Advanced/Types.purs b/src/Quasar/Advanced/Types.purs index 699f076..f71632d 100644 --- a/src/Quasar/Advanced/Types.purs +++ b/src/Quasar/Advanced/Types.purs @@ -59,7 +59,7 @@ instance decodeJsonOperation ∷ DecodeJson Operation where "Read" → pure Read "Modify" → pure Modify "Delete" → pure Delete - _ → Left "Incorrect permission" + _ → Left "Could not parse permission" data AccessType @@ -80,7 +80,7 @@ instance decodeJsonAccessType ∷ DecodeJson AccessType where "Structural" → pure Structural "Content" → pure Content "Mount" → pure Mount - _ → Left "Incorrect resource type" + _ → Left "Could not parse resource type" data QResource @@ -103,21 +103,21 @@ instance decodeJsonQResource ∷ DecodeJson QResource where groupPath = Str.stripPrefix (Str.Pattern "group:") str filePath = Str.stripPrefix (Str.Pattern "data:") str case groupPath, filePath of - Nothing, Nothing → Left "Incorrect resource" + Nothing, Nothing → Left "Could not parse resource" Just pt, _ → map Group - $ lmap (const "Incorrect group resource") + $ lmap (const "Could not parse group resource") $ parseGroupPath pt _, Just pt → - (map File $ lmap (const $ "Incorrect file resource") $ parseFile pt) + (map File $ lmap (const $ "Could not parse file resource") $ parseFile pt) <|> - (map Dir $ lmap (const $ "Incorrect directory resource") $ parseDir pt) + (map Dir $ lmap (const $ "Could not parse directory resource") $ parseDir pt) parseFile ∷ String → Either String AbsFile -parseFile = parseQFilePath >>> note "Incorrect resource" +parseFile = parseQFilePath >>> note "Could not parse resource" parseDir ∷ String → Either String AbsDir -parseDir = parseQDirPath >>> note "Incorrect resource" +parseDir = parseQDirPath >>> note "Could not parse resource" type ActionR = @@ -232,14 +232,14 @@ instance decodeJsonGrantedTo ∷ DecodeJson GrantedTo where -- string isn't email. if isJust (Str.indexOf (Str.Pattern "@") str) then pure str - else Left "Incorrect email" + else Left "Could not parse email" parseUserId ∷ String → Either String UserId parseUserId str = Str.stripPrefix (Str.Pattern "user:") str >>= fromString # map UserId - # note "Incorrect user" + # note "Could not parse user" parseTokenId ∷ String → Either String TokenId @@ -247,13 +247,13 @@ instance decodeJsonGrantedTo ∷ DecodeJson GrantedTo where Str.stripPrefix (Str.Pattern "token:") str >>= fromString # map TokenId - # note "Incorrect token" + # note "Could not parse token" parseGroup ∷ String → Either String GroupPath parseGroup string = Str.stripPrefix (Str.Pattern "group:") string - # note "Incorrect group" + # note "Could not parse group" >>= parseGroupPath @@ -304,7 +304,7 @@ instance decodeJsonGroupInfo ∷ DecodeJson GroupInfo where extractGroups ∷ Array String → Either String (Array GroupPath) extractGroups = traverse \x → - note "Incorrect subgroup" do + note "Could not parse subgroup" do -- Quasar returns file paths for the subgroups, so we have to append a slash dir ← parseQDirPath (x <> "/") pure $ GroupPath dir diff --git a/src/Quasar/Types.purs b/src/Quasar/Types.purs index aadd05a..fb3a92d 100644 --- a/src/Quasar/Types.purs +++ b/src/Quasar/Types.purs @@ -58,7 +58,7 @@ instance decodeJsonCompileResult ∷ DecodeJson CompileResult where <#> CompileResult parseFile ∷ String → Either String AbsFile -parseFile = parseQFilePath >>> note "Incorrect resource" +parseFile = parseQFilePath >>> note "Could not parse resource" compileResultFromString ∷ String → Either String CompileResultR compileResultFromString s = From 36422e159f8003d1ad6664b6e83edf432c4c4297 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 16:46:54 +0400 Subject: [PATCH 09/33] fix Scheme typo --- src/Quasar/Data/URI.purs | 6 +++--- src/Quasar/Mount/Couchbase.purs | 2 +- src/Quasar/Mount/MarkLogic.purs | 2 +- src/Quasar/Mount/MongoDB.purs | 2 +- src/Quasar/Mount/SparkHDFS.purs | 4 ++-- src/Quasar/Mount/View.purs | 2 +- test/src/Test/Main.purs | 2 +- 7 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Quasar/Data/URI.purs b/src/Quasar/Data/URI.purs index 8119f1f..86fbb90 100644 --- a/src/Quasar/Data/URI.purs +++ b/src/Quasar/Data/URI.purs @@ -33,7 +33,7 @@ module Quasar.Data.URI , regNameFromString , portFromInt , printScheme - , unsafeSchemaFromString + , unsafeSchemeFromString , unsafePortFromInt , unsafeRegNameFromString , module URI @@ -234,8 +234,8 @@ opts = printScheme :: URI.Scheme -> String printScheme = Scheme.print -unsafeSchemaFromString :: String -> URI.Scheme -unsafeSchemaFromString = Scheme.unsafeFromString +unsafeSchemeFromString :: String -> URI.Scheme +unsafeSchemeFromString = Scheme.unsafeFromString regNameFromString :: String -> Maybe RegName regNameFromString = RegName.fromString diff --git a/src/Quasar/Mount/Couchbase.purs b/src/Quasar/Mount/Couchbase.purs index 815d41a..572a753 100644 --- a/src/Quasar/Mount/Couchbase.purs +++ b/src/Quasar/Mount/Couchbase.purs @@ -106,5 +106,5 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ host) } uriScheme ∷ URI.Scheme -uriScheme = URI.unsafeSchemaFromString "couchbase" +uriScheme = URI.unsafeSchemeFromString "couchbase" diff --git a/src/Quasar/Mount/MarkLogic.purs b/src/Quasar/Mount/MarkLogic.purs index 85fb856..284c71d 100644 --- a/src/Quasar/Mount/MarkLogic.purs +++ b/src/Quasar/Mount/MarkLogic.purs @@ -94,4 +94,4 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority credent pure { host, path, credentials, format} uriScheme ∷ URI.Scheme -uriScheme = URI.unsafeSchemaFromString "xcc" +uriScheme = URI.unsafeSchemeFromString "xcc" diff --git a/src/Quasar/Mount/MongoDB.purs b/src/Quasar/Mount/MongoDB.purs index d24c526..cc9712e 100644 --- a/src/Quasar/Mount/MongoDB.purs +++ b/src/Quasar/Mount/MongoDB.purs @@ -96,4 +96,4 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority credent pure { hosts, auth: auth', props } uriScheme ∷ URI.Scheme -uriScheme = URI.unsafeSchemaFromString "mongodb" +uriScheme = URI.unsafeSchemeFromString "mongodb" diff --git a/src/Quasar/Mount/SparkHDFS.purs b/src/Quasar/Mount/SparkHDFS.purs index 40fdbd4..c6ad6ba 100644 --- a/src/Quasar/Mount/SparkHDFS.purs +++ b/src/Quasar/Mount/SparkHDFS.purs @@ -107,7 +107,7 @@ extractHost' scheme uri = do URI.HierarchicalPartAuth (URI.Authority _ host) _ → pure host sparkURIScheme ∷ URI.Scheme -sparkURIScheme = URI.unsafeSchemaFromString "spark" +sparkURIScheme = URI.unsafeSchemeFromString "spark" hdfsURIScheme ∷ URI.Scheme -hdfsURIScheme = URI.unsafeSchemaFromString "hdfs" +hdfsURIScheme = URI.unsafeSchemeFromString "hdfs" diff --git a/src/Quasar/Mount/View.purs b/src/Quasar/Mount/View.purs index 0ca0c81..8487202 100644 --- a/src/Quasar/Mount/View.purs +++ b/src/Quasar/Mount/View.purs @@ -75,7 +75,7 @@ fromURI (URI.AbsoluteURI scheme _ query) = do pure { query: q, vars } uriScheme ∷ URI.Scheme -uriScheme = URI.unsafeSchemaFromString "sql2" +uriScheme = URI.unsafeSchemeFromString "sql2" extractQuery ∷ Array (Tuple String (Maybe String)) → Maybe String extractQuery= join <<< lookup "q" diff --git a/test/src/Test/Main.purs b/test/src/Test/Main.purs index 56a81ce..f805adf 100644 --- a/test/src/Test/Main.purs +++ b/test/src/Test/Main.purs @@ -78,7 +78,7 @@ run pred qf = do config ∷ Config () config = { basePath: Left - { scheme: URI.unsafeSchemaFromString "http" + { scheme: URI.unsafeSchemeFromString "http" , authority: Just (URI.Authority Nothing [Both (URI.NameAddress $ URI.unsafeRegNameFromString "localhost") (URI.unsafePortFromInt 53174)]) , path: rootDir } From 3e43b55fc7451a37d1af345983af1c7ff7f9efb9 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 16:59:44 +0400 Subject: [PATCH 10/33] use BasicCodec --- bower.json | 3 ++- src/Quasar/Data/URI.purs | 24 +++++++++++++------- src/Quasar/Mount/Couchbase.purs | 6 ++--- src/Quasar/Mount/MarkLogic.purs | 6 ++--- src/Quasar/Mount/MongoDB.purs | 8 +++---- src/Quasar/Mount/SparkHDFS.purs | 10 ++++---- src/Quasar/Mount/View.purs | 7 +++--- src/Quasar/QuasarF/Interpreter/Internal.purs | 3 ++- test/src/Test/Unit/Main.purs | 6 ++--- 9 files changed, 42 insertions(+), 31 deletions(-) diff --git a/bower.json b/bower.json index 98102a6..a48fe5a 100644 --- a/bower.json +++ b/bower.json @@ -30,7 +30,8 @@ "purescript-strings": "^3.5.0", "purescript-uri": "garyb/purescript-uri#next", "purescript-sql-squared": "safareli/purescript-sql-squared#pathy", - "purescript-const": "^3.2.0" + "purescript-const": "^3.2.0", + "purescript-codec": "^2.1.0" }, "devDependencies": { "purescript-assert": "^3.0.0", diff --git a/src/Quasar/Data/URI.purs b/src/Quasar/Data/URI.purs index 86fbb90..cf68496 100644 --- a/src/Quasar/Data/URI.purs +++ b/src/Quasar/Data/URI.purs @@ -44,6 +44,7 @@ import Prelude import Data.Array (fromFoldable) import Data.Bifunctor (bimap, lmap) import Data.Bitraversable (bitraverse) +import Data.Codec (BasicCodec, basicCodec) import Data.Either (Either(..), either, note) import Data.List (List(..), reverse) import Data.Maybe (Maybe(..), maybe) @@ -80,7 +81,7 @@ import Data.URI.URIRef (print, parser) as URIRef import Partial.Unsafe (unsafeCrashWith) import Pathy (foldPath, posixParser) import Pathy as Py -import Text.Parsing.Parser (Parser) +import Text.Parsing.Parser (ParseError, Parser, runParser) import Type.Row (class RowListNub, class RowToList) type AbsPath = Py.AbsPath @@ -103,13 +104,20 @@ type QURIRefOptions = URI.URIRefOptions URI.UserPassInfo QURIHost AbsPath A type QURI = URI.URI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment type QURIOptions = URI.URIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment -type PrintParse from = { print :: from → String, parser :: Parser String from } -qAbsoluteURI ∷ PrintParse QAbsoluteURI -qAbsoluteURI = { print: AbsoluteURI.print opts.absoluteURI, parser: AbsoluteURI.parser opts.absoluteURI } -qRelativeRef ∷ PrintParse QRelativeRef -qRelativeRef = { print: RelativeRef.print opts.relativeRef, parser: RelativeRef.parser opts.relativeRef } -qURIRef ∷ PrintParse QURIRef -qURIRef = { print: URIRef.print opts.uriRef, parser: URIRef.parser opts.uriRef } +qAbsoluteURI ∷ BasicCodec (Either ParseError) String QAbsoluteURI +qAbsoluteURI = basicCodec + (flip runParser $ AbsoluteURI.parser opts.absoluteURI) + (AbsoluteURI.print opts.absoluteURI) + +qRelativeRef ∷ BasicCodec (Either ParseError) String QRelativeRef +qRelativeRef = basicCodec + (flip runParser $ RelativeRef.parser opts.relativeRef) + (RelativeRef.print opts.relativeRef) + +qURIRef ∷ BasicCodec (Either ParseError) String QURIRef +qURIRef = basicCodec + (flip runParser $ URIRef.parser opts.uriRef) + (URIRef.print opts.uriRef) opts :: { absoluteURI ∷ Record QAbsoluteURIOptions diff --git a/src/Quasar/Mount/Couchbase.purs b/src/Quasar/Mount/Couchbase.purs index 572a753..f5a5e1b 100644 --- a/src/Quasar/Mount/Couchbase.purs +++ b/src/Quasar/Mount/Couchbase.purs @@ -26,6 +26,7 @@ import Prelude import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Bifunctor (lmap) +import Data.Codec (decode, encode) import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Newtype (un) @@ -37,7 +38,6 @@ import Data.Tuple (Tuple(..)) import Pathy (Name(..), ()) import Pathy as P import Quasar.Data.URI as URI -import Text.Parsing.Parser (runParser) type Config = { host ∷ URI.QURIHost @@ -49,13 +49,13 @@ type Config = toJSON ∷ Config → Json toJSON config = - let uri = URI.qAbsoluteURI.print (toURI config) + let uri = encode URI.qAbsoluteURI (toURI config) in "couchbase" := ("connectionUri" := uri ~> jsonEmptyObject) ~> jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON = fromURI - <=< lmap show <<< flip runParser URI.qAbsoluteURI.parser + <=< lmap show <<< decode URI.qAbsoluteURI <=< (_ .? "connectionUri") <=< (_ .? "couchbase") <=< decodeJson diff --git a/src/Quasar/Mount/MarkLogic.purs b/src/Quasar/Mount/MarkLogic.purs index 284c71d..12a906e 100644 --- a/src/Quasar/Mount/MarkLogic.purs +++ b/src/Quasar/Mount/MarkLogic.purs @@ -27,13 +27,13 @@ import Prelude import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Bifunctor (lmap) +import Data.Codec (decode, encode) import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe) import Data.StrMap as SM import Data.Tuple (Tuple(..)) import Pathy (AbsPath) import Quasar.Data.URI as URI -import Text.Parsing.Parser (runParser) type Config = { host ∷ URI.QURIHost @@ -56,13 +56,13 @@ instance showFormat ∷ Show Format where toJSON ∷ Config → Json toJSON config = - let uri = URI.qAbsoluteURI.print (toURI config) + let uri = encode URI.qAbsoluteURI (toURI config) in "marklogic" := ("connectionUri" := uri ~> jsonEmptyObject) ~> jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON = fromURI - <=< lmap show <<< flip runParser URI.qAbsoluteURI.parser + <=< lmap show <<< decode URI.qAbsoluteURI <=< (_ .? "connectionUri") <=< (_ .? "marklogic") <=< decodeJson diff --git a/src/Quasar/Mount/MongoDB.purs b/src/Quasar/Mount/MongoDB.purs index cc9712e..6da9a48 100644 --- a/src/Quasar/Mount/MongoDB.purs +++ b/src/Quasar/Mount/MongoDB.purs @@ -28,14 +28,14 @@ import Prelude import Control.Alt ((<|>)) import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Bifunctor (lmap) +import Data.Codec (decode, encode) import Data.Either (Either(..)) import Data.Foldable (null) import Data.Maybe (Maybe(..), maybe) import Data.Newtype (class Newtype, unwrap) -import Pathy as P import Data.StrMap as SM +import Pathy as P import Quasar.Data.URI as URI -import Text.Parsing.Parser (runParser) newtype Auth = Auth { path ∷ P.AbsPath, credentials ∷ URI.UserPassInfo } @@ -55,13 +55,13 @@ type Config = toJSON ∷ Config → Json toJSON config = - let uri = URI.qAbsoluteURI.print (toURI config) + let uri = encode URI.qAbsoluteURI (toURI config) in "mongodb" := ("connectionUri" := uri ~> jsonEmptyObject) ~> jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON = fromURI - <=< lmap show <<< flip runParser URI.qAbsoluteURI.parser + <=< lmap show <<< decode URI.qAbsoluteURI <=< (_ .? "connectionUri") <=< (_ .? "mongodb") <=< decodeJson diff --git a/src/Quasar/Mount/SparkHDFS.purs b/src/Quasar/Mount/SparkHDFS.purs index c6ad6ba..f6cc8f6 100644 --- a/src/Quasar/Mount/SparkHDFS.purs +++ b/src/Quasar/Mount/SparkHDFS.purs @@ -27,6 +27,7 @@ import Prelude import Data.Argonaut (Json, (.?), (:=), (~>)) import Data.Argonaut as J import Data.Bifunctor (lmap) +import Data.Codec (decode, encode) import Data.Either (Either(..), note) import Data.Maybe (Maybe(..), maybe) import Data.StrMap as SM @@ -35,7 +36,6 @@ import Global (encodeURIComponent, decodeURIComponent) import Pathy (AbsDir) import Quasar.Data.URI as URI import Quasar.Types (parseQDirPath, printQPath) -import Text.Parsing.Parser (runParser) type Config = { sparkHost ∷ URI.QURIHost @@ -46,13 +46,13 @@ type Config = toJSON ∷ Config → Json toJSON config = - let uri = URI.qAbsoluteURI.print (toURI config) + let uri = encode URI.qAbsoluteURI (toURI config) in "spark-hdfs" := ("connectionUri" := uri ~> J.jsonEmptyObject) ~> J.jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON = fromURI - <=< lmap show <<< flip runParser URI.qAbsoluteURI.parser + <=< lmap show <<< decode URI.qAbsoluteURI <=< (_ .? "connectionUri") <=< (_ .? "spark-hdfs") <=< J.decodeJson @@ -63,7 +63,7 @@ toURI cfg = where requiredProps ∷ Array (Tuple String (Maybe String)) requiredProps = - [ Tuple "hdfsUrl" $ Just $ encodeURIComponent $ URI.qAbsoluteURI.print $ mkURI hdfsURIScheme cfg.hdfsHost Nothing + [ Tuple "hdfsUrl" $ Just $ encodeURIComponent $ encode URI.qAbsoluteURI $ mkURI hdfsURIScheme cfg.hdfsHost Nothing , Tuple "rootPath" $ Just $ printQPath cfg.path ] @@ -100,7 +100,7 @@ mkURI scheme host params = extractHost' ∷ URI.Scheme → String → Either String URI.QURIHost extractHost' scheme uri = do - URI.AbsoluteURI scheme' hierPart _ ← lmap show $ runParser uri URI.qAbsoluteURI.parser + URI.AbsoluteURI scheme' hierPart _ ← lmap show $ decode URI.qAbsoluteURI uri unless (scheme' == scheme) $ Left $ "Expected '" <> URI.printScheme scheme <> "' URL scheme" case hierPart of URI.HierarchicalPartNoAuth _ → Left $ "Expected auth part to be present in URL" diff --git a/src/Quasar/Mount/View.purs b/src/Quasar/Mount/View.purs index 8487202..bf91056 100644 --- a/src/Quasar/Mount/View.purs +++ b/src/Quasar/Mount/View.purs @@ -20,6 +20,7 @@ import Prelude import Data.Argonaut (Json, decodeJson, jsonEmptyObject, (.?), (~>), (:=)) import Data.Bifunctor (bimap, lmap) +import Data.Codec (decode, encode) import Data.Either (Either(..), note) import Data.Foldable (foldMap) import Data.Maybe (Maybe(..), maybe) @@ -30,7 +31,7 @@ import Quasar.Data.URI as URI import Quasar.Types (Vars) import SqlSquared (SqlQuery) import SqlSquared as Sql -import Text.Parsing.Parser (ParseError(..), runParser) +import Text.Parsing.Parser (ParseError(..)) import Text.Parsing.Parser.Pos (Position(..)) type Config = @@ -40,13 +41,13 @@ type Config = toJSON ∷ Config → Json toJSON config = - let uri = URI.qAbsoluteURI.print (toURI config) + let uri = encode URI.qAbsoluteURI (toURI config) in "view" := ("connectionUri" := uri ~> jsonEmptyObject) ~> jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON = fromURI - <=< lmap show <<< flip runParser URI.qAbsoluteURI.parser + <=< lmap show <<< decode URI.qAbsoluteURI <=< (_ .? "connectionUri") <=< (_ .? "view") <=< decodeJson diff --git a/src/Quasar/QuasarF/Interpreter/Internal.purs b/src/Quasar/QuasarF/Interpreter/Internal.purs index b4b7c25..bf3ce8e 100644 --- a/src/Quasar/QuasarF/Interpreter/Internal.purs +++ b/src/Quasar/QuasarF/Interpreter/Internal.purs @@ -38,6 +38,7 @@ import Data.Argonaut as Json import Data.Argonaut.Decode.Combinators ((.?), (.??)) import Data.Array as Array import Data.Bifunctor (bimap, lmap) +import Data.Codec (encode) import Data.Either (Either(..), either) import Data.Foldable (oneOf) import Data.Functor.Coproduct (Coproduct, left, right) @@ -107,7 +108,7 @@ mkFSUrl relDir fsPath q = mkUrl (bimap baseify baseify fsPath) q baseify p = relDir p `relativeTo` rootDir mkUrl ∷ ∀ r. RelPath → URI.QQuery → AjaxM r String -mkUrl relPath q = URI.qURIRef.print <$> mkUrl' relPath q +mkUrl relPath q = encode URI.qURIRef <$> mkUrl' relPath q mkUrl' ∷ ∀ r. RelPath → URI.QQuery → AjaxM r URI.QURIRef mkUrl' relPath q = do diff --git a/test/src/Test/Unit/Main.purs b/test/src/Test/Unit/Main.purs index 2cbffe7..cc05db3 100644 --- a/test/src/Test/Unit/Main.purs +++ b/test/src/Test/Unit/Main.purs @@ -21,6 +21,7 @@ import Prelude import Control.Monad.Eff (Eff) import Control.Monad.Eff.Console (CONSOLE, log) import Data.Argonaut.Parser as JP +import Data.Codec (decode, encode) import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Monoid (mempty) @@ -33,7 +34,6 @@ import Quasar.Mount.Couchbase as CB import Quasar.Mount.MongoDB as Mongo import Test.Assert (ASSERT, assert') import Test.Property.Mount.Couchbase as CBT -import Text.Parsing.Parser (runParser) main ∷ ∀ eff. Eff (assert ∷ ASSERT, console ∷ CONSOLE | eff) Unit main = do @@ -68,7 +68,7 @@ main = do , queryTimeout: Just (Seconds (20.0)) }) let mongoURI = - URI.qAbsoluteURI.print + encode URI.qAbsoluteURI (Mongo.toURI { hosts: [Both (URI.NameAddress $ URI.unsafeRegNameFromString "localhost") (URI.unsafePortFromInt 12345)] , auth: Nothing @@ -86,7 +86,7 @@ testURIParse → a → Eff (assert :: ASSERT | eff) Unit testURIParse fromURI uri expected = - case runParser uri URI.qAbsoluteURI.parser of + case decode URI.qAbsoluteURI uri of Left err → fail $ "Test URI failed to parse as a URI even: \n\n\t" <> uri <> "\n\n\t" <> show err <> "\n\n" Right auri → case fromURI auri of From 74a99fa2d628221db2125eb29c5974822305f4cf Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 17:02:42 +0400 Subject: [PATCH 11/33] remove spacing --- src/Quasar/Data/URI.purs | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/src/Quasar/Data/URI.purs b/src/Quasar/Data/URI.purs index cf68496..bfb2510 100644 --- a/src/Quasar/Data/URI.purs +++ b/src/Quasar/Data/URI.purs @@ -19,7 +19,6 @@ module Quasar.Data.URI , QURIHost , QQuery , AbsPath - , RelPath' , AnyPath , QAuthority , QAbsoluteURI @@ -85,24 +84,24 @@ import Text.Parsing.Parser (ParseError, Parser, runParser) import Type.Row (class RowListNub, class RowToList) type AbsPath = Py.AbsPath -type RelPath' = Py.RelPath -type AnyPath = Either AbsPath RelPath' +type AnyPath = Either Py.AbsPath Py.RelPath + type QURIHost = URI.MultiHostPortPair URI.Host URI.Port type QAuthority = URI.Authority URI.UserPassInfo QURIHost type QQuery = URI.QueryPairs String String -type QHierarchicalPart = URI.HierarchicalPart URI.UserPassInfo QURIHost AbsPath AbsPath +type QHierarchicalPart = URI.HierarchicalPart URI.UserPassInfo QURIHost AbsPath AbsPath -type QAbsoluteURI = URI.AbsoluteURI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery +type QAbsoluteURI = URI.AbsoluteURI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery type QAbsoluteURIOptions = URI.AbsoluteURIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery -type QRelativeRef = URI.RelativeRef URI.UserPassInfo QURIHost AbsPath AnyPath QQuery URI.Fragment +type QRelativeRef = URI.RelativeRef URI.UserPassInfo QURIHost AbsPath AnyPath QQuery URI.Fragment type QRelativeRefOptions = URI.RelativeRefOptions URI.UserPassInfo QURIHost AbsPath AnyPath QQuery URI.Fragment -type QURIRef = URI.URIRef URI.UserPassInfo QURIHost AbsPath AbsPath AnyPath QQuery URI.Fragment -type QURIRefOptions = URI.URIRefOptions URI.UserPassInfo QURIHost AbsPath AbsPath AnyPath QQuery URI.Fragment +type QURIRef = URI.URIRef URI.UserPassInfo QURIHost AbsPath AbsPath AnyPath QQuery URI.Fragment +type QURIRefOptions = URI.URIRefOptions URI.UserPassInfo QURIHost AbsPath AbsPath AnyPath QQuery URI.Fragment -type QURI = URI.URI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment -type QURIOptions = URI.URIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment +type QURI = URI.URI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment +type QURIOptions = URI.URIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment qAbsoluteURI ∷ BasicCodec (Either ParseError) String QAbsoluteURI qAbsoluteURI = basicCodec From fc7e01d4ffd20e23188e0e440c6c4228a952e1e0 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 17:30:16 +0400 Subject: [PATCH 12/33] small refactorsRemoved some reexports from quasar.uri --- src/Quasar/Data/URI.purs | 85 ++++++-------------- src/Quasar/Mount/Common/Gen.purs | 6 +- src/Quasar/Mount/Couchbase.purs | 3 +- src/Quasar/Mount/MarkLogic.purs | 3 +- src/Quasar/Mount/MongoDB.purs | 3 +- src/Quasar/Mount/SparkHDFS.purs | 7 +- src/Quasar/Mount/View.purs | 3 +- src/Quasar/QuasarF/Interpreter/Internal.purs | 20 ++--- test/src/Test/Main.purs | 9 ++- test/src/Test/Unit/Main.purs | 8 +- 10 files changed, 59 insertions(+), 88 deletions(-) diff --git a/src/Quasar/Data/URI.purs b/src/Quasar/Data/URI.purs index bfb2510..41e09f5 100644 --- a/src/Quasar/Data/URI.purs +++ b/src/Quasar/Data/URI.purs @@ -15,26 +15,19 @@ limitations under the License. -} module Quasar.Data.URI - ( QHierarchicalPart - , QURIHost - , QQuery - , AbsPath - , AnyPath - , QAuthority - , QAbsoluteURI + ( QAbsoluteURI , qAbsoluteURI , QRelativeRef , qRelativeRef , QURIRef , qURIRef - , QURI + , QHierarchicalPart + , QURIHost + , QQuery + , AbsPath + , AnyPath + , QAuthority , opts - , regNameFromString - , portFromInt - , printScheme - , unsafeSchemeFromString - , unsafePortFromInt - , unsafeRegNameFromString , module URI ) where @@ -51,7 +44,7 @@ import Data.Newtype (un) import Data.Record.Builder as Builder import Data.String.NonEmpty as NES import Data.Tuple (Tuple(..)) -import Data.URI (PathAbsolute, PathRootless, RegName) +import Data.URI (PathAbsolute, PathRootless) import Data.URI (URI(..), RelativePart(..), Authority(..), AbsoluteURI(..), HierarchicalPart(..), HierPath, Host(..), Path(..), Port, RelativeRef(..), URIRef, Fragment, Query, UserInfo) as URI import Data.URI.AbsoluteURI (AbsoluteURIOptions) as URI import Data.URI.AbsoluteURI (print, parser) as AbsoluteURI @@ -62,18 +55,15 @@ import Data.URI.Extra.QueryPairs (QueryPairs(..), Key, Value) as URI import Data.URI.Extra.QueryPairs (print, parse, keyToString, valueToString, keyFromString, valueFromString) as QueryPairs import Data.URI.Extra.UserPassInfo (UserPassInfo(..)) as URI import Data.URI.Extra.UserPassInfo (print, parse) as UserPassInfo -import Data.URI.Host.RegName (fromString, unsafeFromString) as RegName import Data.URI.Path (Path) import Data.URI.Path (print) as Path import Data.URI.Path.Absolute (print, PathAbsolute(..)) as PathAbsolute import Data.URI.Path.NoScheme (print, PathNoScheme(..)) as PathNoScheme import Data.URI.Path.Rootless (print) as PathRootless import Data.URI.Path.Segment (PathSegment, PathSegmentNZ, segmentFromString, unsafeSegmentNZFromString, unsafeSegmentNZNCFromString) -import Data.URI.Port (fromInt, unsafeFromInt) as Port import Data.URI.RelativeRef (RelativeRefOptions) as URI import Data.URI.RelativeRef (print, parser, RelPath) as RelativeRef import Data.URI.Scheme (Scheme) as URI -import Data.URI.Scheme (unsafeFromString, print) as Scheme import Data.URI.URI (URIOptions) as URI import Data.URI.URIRef (URIRefOptions) as URI import Data.URI.URIRef (print, parser) as URIRef @@ -100,8 +90,8 @@ type QRelativeRefOptions = URI.RelativeRefOptions URI.UserPassInfo QURIHost AbsP type QURIRef = URI.URIRef URI.UserPassInfo QURIHost AbsPath AbsPath AnyPath QQuery URI.Fragment type QURIRefOptions = URI.URIRefOptions URI.UserPassInfo QURIHost AbsPath AbsPath AnyPath QQuery URI.Fragment -type QURI = URI.URI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment -type QURIOptions = URI.URIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment +-- type QURI = URI.URI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment +-- type QURIOptions = URI.URIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment qAbsoluteURI ∷ BasicCodec (Either ParseError) String QAbsoluteURI qAbsoluteURI = basicCodec @@ -155,7 +145,7 @@ opts = printHosts = MultiHostPortPair.print id id parsePath :: Path -> Either URIPartParseError AbsPath - parsePath = parseAbsSandboxedPath <<< Path.print + parsePath = _parseAbsPath <<< Path.print printPath ∷ AbsPath → Path printPath = bimap viewAbsDir viewAbsFile >>>case _ of Left d -> @@ -167,7 +157,7 @@ opts = parseHierPath :: Either PathAbsolute PathRootless -> Either URIPartParseError AbsPath - parseHierPath = parseAbsSandboxedPath <<< either PathAbsolute.print PathRootless.print + parseHierPath = _parseAbsPath <<< either PathAbsolute.print PathRootless.print printHierPath ∷ AbsPath → Either PathAbsolute PathRootless printHierPath = _printAbsPath >>> Left @@ -176,20 +166,14 @@ opts = printFragment :: URI.Fragment -> URI.Fragment printFragment = id - parseRelPath :: RelativeRef.RelPath -> Either URIPartParseError AnyPath - parseRelPath = - bitraverse - (PathAbsolute.print >>> parseAbsSandboxedPath) - (PathNoScheme.print >>> parseRelUnsandboxedPath) - - printRelPath :: AnyPath -> RelativeRef.RelPath - printRelPath = - bimap - _printAbsPath - _printRelPath + printRelPath = bimap _printAbsPath _printRelPath + parseRelPath :: RelativeRef.RelPath -> Either URIPartParseError AnyPath + parseRelPath = bitraverse + (PathAbsolute.print >>> _parseAbsPath) + (PathNoScheme.print >>> _parseRelPath) - _printAbsPath :: AbsPath → PathAbsolute + _printAbsPath :: Py.AbsPath → PathAbsolute _printAbsPath = bimap viewAbsDir viewAbsFile >>> case _ of Left Nil -> PathAbsolute.PathAbsolute Nothing Left (Cons head tail) -> PathAbsolute.PathAbsolute $ Just @@ -202,7 +186,7 @@ opts = $ Tuple (asSegmentNZ head) $ (asSegment <$> fromFoldable tail) <> [ asSegment n ] - _printRelPath :: RelPath' → PathNoScheme.PathNoScheme + _printRelPath :: Py.RelPath → PathNoScheme.PathNoScheme _printRelPath = bimap viewRelDir viewRelFile >>> case _ of Left Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString "./") [] Left (Cons head tail) -> @@ -217,44 +201,25 @@ opts = $ (segmentFromString <<< maybe "../" runName <$> fromFoldable tail) <> [ asSegment n ] - parseAbsSandboxedPath :: String -> Either URIPartParseError AbsPath - parseAbsSandboxedPath = + _parseAbsPath :: String -> Either URIPartParseError Py.AbsPath + _parseAbsPath = Py.parsePath posixParser (const Nothing) (Just <<< Left) (const Nothing) (Just <<< Right) Nothing - >>> note (URIPartParseError "got invalid path") + >>> note (URIPartParseError "Could not parse valid absolute path") - parseRelUnsandboxedPath :: String -> Either URIPartParseError RelPath' - parseRelUnsandboxedPath = + _parseRelPath :: String -> Either URIPartParseError Py.RelPath + _parseRelPath = Py.parsePath posixParser (Just <<< Left) (const Nothing) (Just <<< Right) (const Nothing) Nothing - >>> note (URIPartParseError "got invalid path") - - -printScheme :: URI.Scheme -> String -printScheme = Scheme.print - -unsafeSchemeFromString :: String -> URI.Scheme -unsafeSchemeFromString = Scheme.unsafeFromString - -regNameFromString :: String -> Maybe RegName -regNameFromString = RegName.fromString - -unsafeRegNameFromString :: String -> RegName -unsafeRegNameFromString = RegName.unsafeFromString - -unsafePortFromInt :: Int -> URI.Port -unsafePortFromInt = Port.unsafeFromInt - -portFromInt :: Int -> Maybe URI.Port -portFromInt = Port.fromInt + >>> note (URIPartParseError "Could not parse valid relative path") -- Union which rejects duplicates union diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index bbb3056..c823770 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -33,6 +33,8 @@ import Data.String.Gen as SG import Data.String.NonEmpty (NonEmptyString, cons) import Data.These (These(..)) import Data.URI.Host.IPv4Address (fromInts) as IPv4Address +import Data.URI.Host.RegName as RegName +import Data.URI.Port as Port import Pathy.Gen (genAbsDirPath, genAbsFilePath) as PGen import Quasar.Data.URI as URI @@ -58,10 +60,10 @@ genHostURI = Gen.oneOf $ genIPv4 :| [genName] genRegName = filtered do head ← S.singleton <$> CG.genAlpha tail ← genAlphaNumericString - pure $ URI.regNameFromString $ head <> tail + pure $ RegName.fromString $ head <> tail genPort ∷ ∀ m. MonadRec m => MonadGen m ⇒ m URI.Port -genPort = filtered $ URI.portFromInt <$> Gen.chooseInt 50000 65535 +genPort = filtered $ Port.fromInt <$> Gen.chooseInt 50000 65535 genHost ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.QURIHost genHost = Gen.unfoldable $ genThese genHostURI genPort diff --git a/src/Quasar/Mount/Couchbase.purs b/src/Quasar/Mount/Couchbase.purs index f5a5e1b..be5d95b 100644 --- a/src/Quasar/Mount/Couchbase.purs +++ b/src/Quasar/Mount/Couchbase.purs @@ -35,6 +35,7 @@ import Data.StrMap as SM import Data.String.NonEmpty (NonEmptyString) import Data.Time.Duration (Seconds(..)) import Data.Tuple (Tuple(..)) +import Data.URI.Scheme as Scheme import Pathy (Name(..), ()) import Pathy as P import Quasar.Data.URI as URI @@ -106,5 +107,5 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ host) } uriScheme ∷ URI.Scheme -uriScheme = URI.unsafeSchemeFromString "couchbase" +uriScheme = Scheme.unsafeFromString "couchbase" diff --git a/src/Quasar/Mount/MarkLogic.purs b/src/Quasar/Mount/MarkLogic.purs index 12a906e..11c7720 100644 --- a/src/Quasar/Mount/MarkLogic.purs +++ b/src/Quasar/Mount/MarkLogic.purs @@ -32,6 +32,7 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe) import Data.StrMap as SM import Data.Tuple (Tuple(..)) +import Data.URI.Scheme as Scheme import Pathy (AbsPath) import Quasar.Data.URI as URI @@ -94,4 +95,4 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority credent pure { host, path, credentials, format} uriScheme ∷ URI.Scheme -uriScheme = URI.unsafeSchemeFromString "xcc" +uriScheme = Scheme.unsafeFromString "xcc" diff --git a/src/Quasar/Mount/MongoDB.purs b/src/Quasar/Mount/MongoDB.purs index 6da9a48..54cf0d8 100644 --- a/src/Quasar/Mount/MongoDB.purs +++ b/src/Quasar/Mount/MongoDB.purs @@ -34,6 +34,7 @@ import Data.Foldable (null) import Data.Maybe (Maybe(..), maybe) import Data.Newtype (class Newtype, unwrap) import Data.StrMap as SM +import Data.URI.Scheme as Scheme import Pathy as P import Quasar.Data.URI as URI @@ -96,4 +97,4 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority credent pure { hosts, auth: auth', props } uriScheme ∷ URI.Scheme -uriScheme = URI.unsafeSchemeFromString "mongodb" +uriScheme = Scheme.unsafeFromString "mongodb" diff --git a/src/Quasar/Mount/SparkHDFS.purs b/src/Quasar/Mount/SparkHDFS.purs index f6cc8f6..f1813bb 100644 --- a/src/Quasar/Mount/SparkHDFS.purs +++ b/src/Quasar/Mount/SparkHDFS.purs @@ -32,6 +32,7 @@ import Data.Either (Either(..), note) import Data.Maybe (Maybe(..), maybe) import Data.StrMap as SM import Data.Tuple (Tuple(..)) +import Data.URI.Scheme as Scheme import Global (encodeURIComponent, decodeURIComponent) import Pathy (AbsDir) import Quasar.Data.URI as URI @@ -101,13 +102,13 @@ mkURI scheme host params = extractHost' ∷ URI.Scheme → String → Either String URI.QURIHost extractHost' scheme uri = do URI.AbsoluteURI scheme' hierPart _ ← lmap show $ decode URI.qAbsoluteURI uri - unless (scheme' == scheme) $ Left $ "Expected '" <> URI.printScheme scheme <> "' URL scheme" + unless (scheme' == scheme) $ Left $ "Expected '" <> Scheme.print scheme <> "' URL scheme" case hierPart of URI.HierarchicalPartNoAuth _ → Left $ "Expected auth part to be present in URL" URI.HierarchicalPartAuth (URI.Authority _ host) _ → pure host sparkURIScheme ∷ URI.Scheme -sparkURIScheme = URI.unsafeSchemeFromString "spark" +sparkURIScheme = Scheme.unsafeFromString "spark" hdfsURIScheme ∷ URI.Scheme -hdfsURIScheme = URI.unsafeSchemeFromString "hdfs" +hdfsURIScheme = Scheme.unsafeFromString "hdfs" diff --git a/src/Quasar/Mount/View.purs b/src/Quasar/Mount/View.purs index bf91056..074309c 100644 --- a/src/Quasar/Mount/View.purs +++ b/src/Quasar/Mount/View.purs @@ -27,6 +27,7 @@ import Data.Maybe (Maybe(..), maybe) import Data.StrMap as SM import Data.String as Str import Data.Tuple (Tuple(..), lookup) +import Data.URI.Scheme as Scheme import Quasar.Data.URI as URI import Quasar.Types (Vars) import SqlSquared (SqlQuery) @@ -76,7 +77,7 @@ fromURI (URI.AbsoluteURI scheme _ query) = do pure { query: q, vars } uriScheme ∷ URI.Scheme -uriScheme = URI.unsafeSchemeFromString "sql2" +uriScheme = Scheme.unsafeFromString "sql2" extractQuery ∷ Array (Tuple String (Maybe String)) → Maybe String extractQuery= join <<< lookup "q" diff --git a/src/Quasar/QuasarF/Interpreter/Internal.purs b/src/Quasar/QuasarF/Interpreter/Internal.purs index bf3ce8e..5d8c6c5 100644 --- a/src/Quasar/QuasarF/Interpreter/Internal.purs +++ b/src/Quasar/QuasarF/Interpreter/Internal.purs @@ -116,19 +116,13 @@ mkUrl' relPath q = do pure (bimap toURI toRelativeRef basePath) where toURI { scheme, authority, path } = - URI.URI - scheme - (case authority of - Nothing -> - URI.HierarchicalPartNoAuth - (Just (bimap (path _) (path _) relPath)) - Just authority' -> - URI.HierarchicalPartAuth - authority' - (Just (bimap (path _) (path _) relPath)) - ) - (if q == mempty then Nothing else Just q) - Nothing + let + hierPath = (Just (bimap (path _) (path _) relPath)) + hierPart = case authority of + Nothing -> URI.HierarchicalPartNoAuth hierPath + Just authority' -> URI.HierarchicalPartAuth authority' hierPath + query = if q == mempty then Nothing else Just q + in URI.URI scheme hierPart query Nothing toRelativeRef :: RelDir -> URI.QRelativeRef toRelativeRef relDir = diff --git a/test/src/Test/Main.purs b/test/src/Test/Main.purs index f805adf..f6dc862 100644 --- a/test/src/Test/Main.purs +++ b/test/src/Test/Main.purs @@ -34,13 +34,15 @@ import Data.Either (Either(..), isRight) import Data.Foldable (traverse_) import Data.Functor.Coproduct (left) import Data.Maybe (Maybe(..)) -import Pathy (rootDir, dir, file, ()) import Data.Posix.Signal (Signal(SIGTERM)) import Data.StrMap as SM import Data.String as Str import Data.Symbol (SProxy(..)) import Data.These (These(..)) import Data.Tuple (Tuple(..)) +import Data.URI.Host.RegName as RegName +import Data.URI.Port as Port +import Data.URI.Scheme as Scheme import Network.HTTP.Affjax (AJAX) import Node.ChildProcess as CP import Node.Encoding (Encoding(..)) @@ -49,6 +51,7 @@ import Node.Process (PROCESS) import Node.Process as Proc import Partial (crashWith) import Partial.Unsafe (unsafePartial) +import Pathy (rootDir, dir, file, ()) import Quasar.Advanced.QuasarAF.Interpreter.Aff (Config, eval) import Quasar.Data (QData(..)) import Quasar.Data.Json as Json @@ -78,8 +81,8 @@ run pred qf = do config ∷ Config () config = { basePath: Left - { scheme: URI.unsafeSchemeFromString "http" - , authority: Just (URI.Authority Nothing [Both (URI.NameAddress $ URI.unsafeRegNameFromString "localhost") (URI.unsafePortFromInt 53174)]) + { scheme: Scheme.unsafeFromString "http" + , authority: Just (URI.Authority Nothing [Both (URI.NameAddress $ RegName.unsafeFromString "localhost") (Port.unsafeFromInt 53174)]) , path: rootDir } , idToken: Nothing diff --git a/test/src/Test/Unit/Main.purs b/test/src/Test/Unit/Main.purs index cc05db3..cda6211 100644 --- a/test/src/Test/Unit/Main.purs +++ b/test/src/Test/Unit/Main.purs @@ -28,6 +28,8 @@ import Data.Monoid (mempty) import Data.String.NonEmpty (fromString) import Data.These (These(..)) import Data.Time.Duration (Seconds(..)) +import Data.URI.Host.RegName as RegName +import Data.URI.Port as Port import Quasar.Data.URI as URI import Quasar.Mount as QM import Quasar.Mount.Couchbase as CB @@ -51,7 +53,7 @@ main = do testURIParse (map CBT.TestConfig <$> CB.fromURI) "couchbase://localhost/testBucket?password=&docTypeKey=" (CBT.TestConfig - { host: [ This (URI.NameAddress $ URI.unsafeRegNameFromString "localhost") ] + { host: [ This (URI.NameAddress $ RegName.unsafeFromString "localhost") ] , bucketName: fromString "testBucket" , password: "" , docTypeKey: "" @@ -61,7 +63,7 @@ main = do testURIParse (map CBT.TestConfig <$> CB.fromURI) "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (CBT.TestConfig - { host: [Both (URI.NameAddress $ URI.unsafeRegNameFromString "localhost") (URI.unsafePortFromInt 99999)] + { host: [Both (URI.NameAddress $ RegName.unsafeFromString "localhost") (Port.unsafeFromInt 99999)] , bucketName: fromString "testBucket" , password: "pass" , docTypeKey: "type" @@ -70,7 +72,7 @@ main = do let mongoURI = encode URI.qAbsoluteURI (Mongo.toURI - { hosts: [Both (URI.NameAddress $ URI.unsafeRegNameFromString "localhost") (URI.unsafePortFromInt 12345)] + { hosts: [Both (URI.NameAddress $ RegName.unsafeFromString "localhost") (Port.unsafeFromInt 12345)] , auth: Nothing , props: mempty}) if mongoURI == "mongodb://localhost:12345/" From 8a9d618143e79b95bf1f4259d64be257edd945af Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 18:28:41 +0400 Subject: [PATCH 13/33] add MongoURI type --- src/Quasar/Data/URI.purs | 37 +++++++++++++++++++++++++------ src/Quasar/Mount/Common/Gen.purs | 6 ++++- src/Quasar/Mount/MongoDB.purs | 10 ++++----- src/Quasar/Mount/MongoDB/Gen.purs | 4 ++-- 4 files changed, 42 insertions(+), 15 deletions(-) diff --git a/src/Quasar/Data/URI.purs b/src/Quasar/Data/URI.purs index 41e09f5..e545d10 100644 --- a/src/Quasar/Data/URI.purs +++ b/src/Quasar/Data/URI.purs @@ -17,12 +17,15 @@ limitations under the License. module Quasar.Data.URI ( QAbsoluteURI , qAbsoluteURI + , MongoURI + , mongoURI , QRelativeRef , qRelativeRef , QURIRef , qURIRef , QHierarchicalPart , QURIHost + , QURIHosts , QQuery , AbsPath , AnyPath @@ -49,6 +52,8 @@ import Data.URI (URI(..), RelativePart(..), Authority(..), AbsoluteURI(..), Hier import Data.URI.AbsoluteURI (AbsoluteURIOptions) as URI import Data.URI.AbsoluteURI (print, parser) as AbsoluteURI import Data.URI.Common (URIPartParseError(..)) +import Data.URI.HostPortPair (HostPortPair) as URI +import Data.URI.HostPortPair (print, parser) as HostPortPair import Data.URI.Extra.MultiHostPortPair (MultiHostPortPair) as URI import Data.URI.Extra.MultiHostPortPair (print, parser) as MultiHostPortPair import Data.URI.Extra.QueryPairs (QueryPairs(..), Key, Value) as URI @@ -76,7 +81,9 @@ import Type.Row (class RowListNub, class RowToList) type AbsPath = Py.AbsPath type AnyPath = Either Py.AbsPath Py.RelPath -type QURIHost = URI.MultiHostPortPair URI.Host URI.Port +type QURIHost = URI.HostPortPair URI.Host URI.Port +type QURIHosts = URI.MultiHostPortPair URI.Host URI.Port + type QAuthority = URI.Authority URI.UserPassInfo QURIHost type QQuery = URI.QueryPairs String String type QHierarchicalPart = URI.HierarchicalPart URI.UserPassInfo QURIHost AbsPath AbsPath @@ -84,6 +91,9 @@ type QHierarchicalPart = URI.HierarchicalPart URI.UserPassInfo QURIHost AbsPath type QAbsoluteURI = URI.AbsoluteURI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery type QAbsoluteURIOptions = URI.AbsoluteURIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery +type MongoURI = URI.AbsoluteURI URI.UserPassInfo QURIHosts AbsPath AbsPath QQuery +type MongoURIOptions = URI.AbsoluteURIOptions URI.UserPassInfo QURIHosts AbsPath AbsPath QQuery + type QRelativeRef = URI.RelativeRef URI.UserPassInfo QURIHost AbsPath AnyPath QQuery URI.Fragment type QRelativeRefOptions = URI.RelativeRefOptions URI.UserPassInfo QURIHost AbsPath AnyPath QQuery URI.Fragment @@ -98,6 +108,11 @@ qAbsoluteURI = basicCodec (flip runParser $ AbsoluteURI.parser opts.absoluteURI) (AbsoluteURI.print opts.absoluteURI) +mongoURI ∷ BasicCodec (Either ParseError) String MongoURI +mongoURI = basicCodec + (flip runParser $ AbsoluteURI.parser opts.mongoURI) + (AbsoluteURI.print opts.mongoURI) + qRelativeRef ∷ BasicCodec (Either ParseError) String QRelativeRef qRelativeRef = basicCodec (flip runParser $ RelativeRef.parser opts.relativeRef) @@ -110,18 +125,21 @@ qURIRef = basicCodec opts :: { absoluteURI ∷ Record QAbsoluteURIOptions + , mongoURI ∷ Record MongoURIOptions , relativeRef ∷ Record QRelativeRefOptions , uriRef ∷ Record QURIRefOptions } opts = - { absoluteURI: _common `union` _Path `union` _HierPath - , relativeRef: _common `union` _Path`union` _Fragment `union` _RelPath - , uriRef: _common `union` _HierPath `union` _Path `union` _Fragment `union` _RelPath + { absoluteURI: _common `union` _Host `union` _Path `union` _HierPath + , mongoURI: _common `union` _Hosts `union` _Path `union` _HierPath + , relativeRef: _common `union` _Host `union` _Path`union` _Fragment `union` _RelPath + , uriRef: _common `union` _Host `union` _HierPath `union` _Path `union` _Fragment `union` _RelPath } where - _common = _UserInfo `union` _Hosts `union` _Query + _common = _UserInfo `union` _Query _UserInfo = { parseUserInfo, printUserInfo } + _Host = { parseHosts: parseHost, printHosts: printHost } _Hosts = { parseHosts, printHosts } _Query = { parseQuery, printQuery } _Path = { parsePath, printPath } @@ -139,9 +157,14 @@ opts = printUserInfo :: URI.UserPassInfo -> URI.UserInfo printUserInfo = UserPassInfo.print - parseHosts :: Parser String QURIHost + parseHost :: Parser String QURIHost + parseHost = HostPortPair.parser pure pure + printHost :: QURIHost -> String + printHost = HostPortPair.print id id + + parseHosts :: Parser String QURIHosts parseHosts = MultiHostPortPair.parser pure pure - printHosts :: QURIHost -> String + printHosts :: QURIHosts -> String printHosts = MultiHostPortPair.print id id parsePath :: Path -> Either URIPartParseError AbsPath diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index c823770..53cf013 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -23,6 +23,7 @@ import Prelude import Control.Monad.Gen (class MonadGen, filtered) import Control.Monad.Gen as Gen +import Control.Monad.Gen.Common (genMaybe) import Control.Monad.Gen.Common as GenC import Control.Monad.Rec.Class (class MonadRec) import Data.Char.Gen as CG @@ -66,7 +67,10 @@ genPort ∷ ∀ m. MonadRec m => MonadGen m ⇒ m URI.Port genPort = filtered $ Port.fromInt <$> Gen.chooseInt 50000 65535 genHost ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.QURIHost -genHost = Gen.unfoldable $ genThese genHostURI genPort +genHost = genMaybe $ genThese genHostURI genPort + +genHosts ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.QURIHosts +genHosts = Gen.unfoldable $ genThese genHostURI genPort genThese ∷ ∀ m a b. MonadGen m ⇒ MonadRec m ⇒ m a -> m b -> m (These a b) genThese ma mb = filtered do diff --git a/src/Quasar/Mount/MongoDB.purs b/src/Quasar/Mount/MongoDB.purs index 54cf0d8..0d4f6db 100644 --- a/src/Quasar/Mount/MongoDB.purs +++ b/src/Quasar/Mount/MongoDB.purs @@ -49,25 +49,25 @@ instance showAuth ∷ Show Auth where "(Auth { path: " <> show path <> ", credentials: " <> show credentials <> " })" type Config = - { hosts ∷ URI.QURIHost + { hosts ∷ URI.QURIHosts , auth ∷ Maybe Auth , props ∷ SM.StrMap (Maybe String) } toJSON ∷ Config → Json toJSON config = - let uri = encode URI.qAbsoluteURI (toURI config) + let uri = encode URI.mongoURI (toURI config) in "mongodb" := ("connectionUri" := uri ~> jsonEmptyObject) ~> jsonEmptyObject fromJSON ∷ Json → Either String Config fromJSON = fromURI - <=< lmap show <<< decode URI.qAbsoluteURI + <=< lmap show <<< decode URI.mongoURI <=< (_ .? "connectionUri") <=< (_ .? "mongodb") <=< decodeJson -toURI ∷ Config → URI.QAbsoluteURI +toURI ∷ Config → URI.MongoURI toURI { hosts, auth, props } = URI.AbsoluteURI uriScheme @@ -81,7 +81,7 @@ toURI { hosts, auth, props } = else Just (URI.QueryPairs (SM.toUnfoldable props))) -fromURI ∷ URI.QAbsoluteURI → Either String Config +fromURI ∷ URI.MongoURI → Either String Config fromURI (URI.AbsoluteURI _ (URI.HierarchicalPartNoAuth _) _) = do Left "Expected 'auth' part in URI" fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority credentials hosts) path) query) = do diff --git a/src/Quasar/Mount/MongoDB/Gen.purs b/src/Quasar/Mount/MongoDB/Gen.purs index c31d714..0039e0e 100644 --- a/src/Quasar/Mount/MongoDB/Gen.purs +++ b/src/Quasar/Mount/MongoDB/Gen.purs @@ -23,13 +23,13 @@ import Control.Monad.Gen.Common as GenC import Control.Monad.Rec.Class (class MonadRec) import Data.StrMap.Gen as SMG import Pathy.Gen (genAbsAnyPath) -import Quasar.Mount.Common.Gen (genAlphaNumericString, genHost, genCredentials) +import Quasar.Mount.Common.Gen (genAlphaNumericString, genHosts, genCredentials) import Quasar.Mount.MongoDB as MDB genConfig ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m MDB.Config genConfig = { hosts: _, auth: _, props: _ } - <$> genHost + <$> genHosts <*> GenC.genMaybe genAuth <*> SMG.genStrMap genAlphaNumericString (GenC.genMaybe genAlphaNumericString) From fa53800b51aac9768b0da31707efad957f5c07c3 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 27 Feb 2018 18:39:35 +0400 Subject: [PATCH 14/33] fix build --- src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs | 2 +- test/src/Test/Main.purs | 2 +- test/src/Test/Unit/Main.purs | 6 +++--- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs b/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs index 5dd1ce7..25a9565 100644 --- a/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs +++ b/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs @@ -180,7 +180,7 @@ evalQuasarAdvanced (CreateToken mbName actions k) = do } evalQuasarAdvanced (UpdateToken tid actions k) = do config ← ask - url ← mkUrl (Right (Paths.token Pt.file (Qa.runTokenId tid))) mempty + url ← mkUrl (Right (Paths.token Pt.file' (Name $ Qa.runTokenId tid))) mempty map k $ mkAuthedRequest (jsonResult >>> map Qa.runToken) $ _{ url = url diff --git a/test/src/Test/Main.purs b/test/src/Test/Main.purs index f6dc862..cb9461a 100644 --- a/test/src/Test/Main.purs +++ b/test/src/Test/Main.purs @@ -82,7 +82,7 @@ config ∷ Config () config = { basePath: Left { scheme: Scheme.unsafeFromString "http" - , authority: Just (URI.Authority Nothing [Both (URI.NameAddress $ RegName.unsafeFromString "localhost") (Port.unsafeFromInt 53174)]) + , authority: Just $ URI.Authority Nothing $ Just $ Both (URI.NameAddress $ RegName.unsafeFromString "localhost") (Port.unsafeFromInt 53174) , path: rootDir } , idToken: Nothing diff --git a/test/src/Test/Unit/Main.purs b/test/src/Test/Unit/Main.purs index cda6211..1c82d0e 100644 --- a/test/src/Test/Unit/Main.purs +++ b/test/src/Test/Unit/Main.purs @@ -53,7 +53,7 @@ main = do testURIParse (map CBT.TestConfig <$> CB.fromURI) "couchbase://localhost/testBucket?password=&docTypeKey=" (CBT.TestConfig - { host: [ This (URI.NameAddress $ RegName.unsafeFromString "localhost") ] + { host: Just $ This (URI.NameAddress $ RegName.unsafeFromString "localhost") , bucketName: fromString "testBucket" , password: "" , docTypeKey: "" @@ -63,14 +63,14 @@ main = do testURIParse (map CBT.TestConfig <$> CB.fromURI) "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (CBT.TestConfig - { host: [Both (URI.NameAddress $ RegName.unsafeFromString "localhost") (Port.unsafeFromInt 99999)] + { host: Just $ Both (URI.NameAddress $ RegName.unsafeFromString "localhost") (Port.unsafeFromInt 99999) , bucketName: fromString "testBucket" , password: "pass" , docTypeKey: "type" , queryTimeout: Just (Seconds (20.0)) }) let mongoURI = - encode URI.qAbsoluteURI + encode URI.mongoURI (Mongo.toURI { hosts: [Both (URI.NameAddress $ RegName.unsafeFromString "localhost") (Port.unsafeFromInt 12345)] , auth: Nothing From b22bf01b3f27a45b03937728268cd944c59cbbf0 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Wed, 28 Feb 2018 17:25:24 +0400 Subject: [PATCH 15/33] update uri --- src/Quasar/Data/URI.purs | 25 +++++++++++++++++-------- src/Quasar/Mount/Common/Gen.purs | 7 ++++--- test/src/Test/Main.purs | 8 +++++++- test/src/Test/Unit/Main.purs | 8 +++++--- 4 files changed, 33 insertions(+), 15 deletions(-) diff --git a/src/Quasar/Data/URI.purs b/src/Quasar/Data/URI.purs index e545d10..1d368b9 100644 --- a/src/Quasar/Data/URI.purs +++ b/src/Quasar/Data/URI.purs @@ -45,6 +45,7 @@ import Data.List (List(..), reverse) import Data.Maybe (Maybe(..), maybe) import Data.Newtype (un) import Data.Record.Builder as Builder +import Data.String.NonEmpty (NonEmptyString, fromString) import Data.String.NonEmpty as NES import Data.Tuple (Tuple(..)) import Data.URI (PathAbsolute, PathRootless) @@ -52,14 +53,14 @@ import Data.URI (URI(..), RelativePart(..), Authority(..), AbsoluteURI(..), Hier import Data.URI.AbsoluteURI (AbsoluteURIOptions) as URI import Data.URI.AbsoluteURI (print, parser) as AbsoluteURI import Data.URI.Common (URIPartParseError(..)) -import Data.URI.HostPortPair (HostPortPair) as URI -import Data.URI.HostPortPair (print, parser) as HostPortPair import Data.URI.Extra.MultiHostPortPair (MultiHostPortPair) as URI import Data.URI.Extra.MultiHostPortPair (print, parser) as MultiHostPortPair import Data.URI.Extra.QueryPairs (QueryPairs(..), Key, Value) as URI import Data.URI.Extra.QueryPairs (print, parse, keyToString, valueToString, keyFromString, valueFromString) as QueryPairs import Data.URI.Extra.UserPassInfo (UserPassInfo(..)) as URI import Data.URI.Extra.UserPassInfo (print, parse) as UserPassInfo +import Data.URI.HostPortPair (HostPortPair) as URI +import Data.URI.HostPortPair (print, parser) as HostPortPair import Data.URI.Path (Path) import Data.URI.Path (print) as Path import Data.URI.Path.Absolute (print, PathAbsolute(..)) as PathAbsolute @@ -73,7 +74,7 @@ import Data.URI.URI (URIOptions) as URI import Data.URI.URIRef (URIRefOptions) as URI import Data.URI.URIRef (print, parser) as URIRef import Partial.Unsafe (unsafeCrashWith) -import Pathy (foldPath, posixParser) +import Pathy (Name(..), foldPath, posixParser) import Pathy as Py import Text.Parsing.Parser (ParseError, Parser, runParser) import Type.Row (class RowListNub, class RowToList) @@ -211,19 +212,27 @@ opts = _printRelPath :: Py.RelPath → PathNoScheme.PathNoScheme _printRelPath = bimap viewRelDir viewRelFile >>> case _ of - Left Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString "./") [] + Left Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString currentDirSegment) [] Left (Cons head tail) -> PathNoScheme.PathNoScheme - $ Tuple (unsafeSegmentNZNCFromString $ maybe "../" runName head) + $ Tuple (unsafeSegmentNZNCFromString $ maybe parentDirSegment (un Name) head) $ (segmentFromString <<< maybe "../" runName <$> fromFoldable tail) <> [ segmentFromString "" ] Right (Tuple d n) -> case d of - Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ runName n) [] + Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ un Name n) [] Cons head tail -> PathNoScheme.PathNoScheme - $ Tuple (unsafeSegmentNZNCFromString $ maybe "../" runName head) + $ Tuple (unsafeSegmentNZNCFromString $ maybe parentDirSegment (un Name) head) $ (segmentFromString <<< maybe "../" runName <$> fromFoldable tail) <> [ asSegment n ] + currentDirSegment :: NonEmptyString + currentDirSegment = case NES.fromString "./" of + Nothing -> unsafeCrashWith "unreachable case in currentDirSegment" + Just a -> a + parentDirSegment :: NonEmptyString + parentDirSegment = case NES.fromString "../" of + Nothing -> unsafeCrashWith "unreachable case in parentDirSegment" + Just a -> a _parseAbsPath :: String -> Either URIPartParseError Py.AbsPath _parseAbsPath = Py.parsePath posixParser @@ -256,7 +265,7 @@ union union r1 r2 = Builder.build (Builder.merge r2) r1 asSegmentNZ :: forall a. Py.Name a -> PathSegmentNZ -asSegmentNZ = runName >>> unsafeSegmentNZFromString +asSegmentNZ = un Py.Name >>> unsafeSegmentNZFromString asSegment :: forall a. Py.Name a -> PathSegment asSegment = runName >>> segmentFromString diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index 53cf013..5602a55 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -32,6 +32,7 @@ import Data.NonEmpty ((:|)) import Data.String as S import Data.String.Gen as SG import Data.String.NonEmpty (NonEmptyString, cons) +import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.URI.Host.IPv4Address (fromInts) as IPv4Address import Data.URI.Host.RegName as RegName @@ -58,10 +59,10 @@ genHostURI = Gen.oneOf $ genIPv4 :| [genName] d ← Gen.chooseInt 1 254 pure $ URI.IPv4Address <$> IPv4Address.fromInts a b c d genName = URI.NameAddress <$> genRegName - genRegName = filtered do - head ← S.singleton <$> CG.genAlpha + genRegName = do + head ← CG.genAlpha tail ← genAlphaNumericString - pure $ RegName.fromString $ head <> tail + pure $ RegName.fromString $ NES.cons head tail genPort ∷ ∀ m. MonadRec m => MonadGen m ⇒ m URI.Port genPort = filtered $ Port.fromInt <$> Gen.chooseInt 50000 65535 diff --git a/test/src/Test/Main.purs b/test/src/Test/Main.purs index cb9461a..6915a8d 100644 --- a/test/src/Test/Main.purs +++ b/test/src/Test/Main.purs @@ -37,6 +37,7 @@ import Data.Maybe (Maybe(..)) import Data.Posix.Signal (Signal(SIGTERM)) import Data.StrMap as SM import Data.String as Str +import Data.String.NonEmpty as NES import Data.Symbol (SProxy(..)) import Data.These (These(..)) import Data.Tuple (Tuple(..)) @@ -82,7 +83,12 @@ config ∷ Config () config = { basePath: Left { scheme: Scheme.unsafeFromString "http" - , authority: Just $ URI.Authority Nothing $ Just $ Both (URI.NameAddress $ RegName.unsafeFromString "localhost") (Port.unsafeFromInt 53174) + , authority: Just + $ URI.Authority Nothing + $ Just + $ Both + (URI.NameAddress $ RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost") + (Port.unsafeFromInt 53174) , path: rootDir } , idToken: Nothing diff --git a/test/src/Test/Unit/Main.purs b/test/src/Test/Unit/Main.purs index 1c82d0e..f5948a5 100644 --- a/test/src/Test/Unit/Main.purs +++ b/test/src/Test/Unit/Main.purs @@ -26,10 +26,12 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Monoid (mempty) import Data.String.NonEmpty (fromString) +import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.Time.Duration (Seconds(..)) import Data.URI.Host.RegName as RegName import Data.URI.Port as Port +import Partial.Unsafe (unsafePartial) import Quasar.Data.URI as URI import Quasar.Mount as QM import Quasar.Mount.Couchbase as CB @@ -53,7 +55,7 @@ main = do testURIParse (map CBT.TestConfig <$> CB.fromURI) "couchbase://localhost/testBucket?password=&docTypeKey=" (CBT.TestConfig - { host: Just $ This (URI.NameAddress $ RegName.unsafeFromString "localhost") + { host: Just $ This (URI.NameAddress $ RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost") , bucketName: fromString "testBucket" , password: "" , docTypeKey: "" @@ -63,7 +65,7 @@ main = do testURIParse (map CBT.TestConfig <$> CB.fromURI) "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (CBT.TestConfig - { host: Just $ Both (URI.NameAddress $ RegName.unsafeFromString "localhost") (Port.unsafeFromInt 99999) + { host: Just $ Both (URI.NameAddress $ RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost") (Port.unsafeFromInt 99999) , bucketName: fromString "testBucket" , password: "pass" , docTypeKey: "type" @@ -72,7 +74,7 @@ main = do let mongoURI = encode URI.mongoURI (Mongo.toURI - { hosts: [Both (URI.NameAddress $ RegName.unsafeFromString "localhost") (Port.unsafeFromInt 12345)] + { hosts: [Both (URI.NameAddress $ RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost") (Port.unsafeFromInt 12345)] , auth: Nothing , props: mempty}) if mongoURI == "mongodb://localhost:12345/" From 2cf844cac2604754b1ed3fa3ac70ec02d3da8451 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Wed, 28 Feb 2018 16:18:18 +0000 Subject: [PATCH 16/33] Update for Data.URI -> URI namespace change --- .../Advanced/QuasarAF/Interpreter/Affjax.purs | 2 +- .../QuasarAF/Interpreter/Internal.purs | 4 +- src/Quasar/Mount/Common/Gen.purs | 16 ++--- src/Quasar/Mount/Couchbase.purs | 9 ++- src/Quasar/Mount/MarkLogic.purs | 4 +- src/Quasar/Mount/MongoDB.purs | 4 +- src/Quasar/Mount/SparkHDFS.purs | 6 +- src/Quasar/Mount/View.purs | 6 +- src/Quasar/QuasarF/Interpreter/Affjax.purs | 4 +- src/Quasar/QuasarF/Interpreter/Config.purs | 2 +- src/Quasar/QuasarF/Interpreter/Internal.purs | 8 +-- src/Quasar/{Data => }/URI.purs | 71 +++++++++---------- test/src/Test/Main.purs | 8 +-- test/src/Test/Unit/Main.purs | 10 +-- 14 files changed, 73 insertions(+), 81 deletions(-) rename src/Quasar/{Data => }/URI.purs (83%) diff --git a/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs b/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs index 25a9565..a75deca 100644 --- a/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs +++ b/src/Quasar/Advanced/QuasarAF/Interpreter/Affjax.purs @@ -49,10 +49,10 @@ import Quasar.Advanced.QuasarAF.Interpreter.Config (Config) import Quasar.Advanced.QuasarAF.Interpreter.Internal (mkGroupUrl) import Quasar.Advanced.Types as Qa import Quasar.ConfigF as CF -import Quasar.Data.URI as URI import Quasar.Error (QResponse) import Quasar.QuasarF.Interpreter.Affjax as QCI import Quasar.QuasarF.Interpreter.Internal (ask, defaultRequest, jsonResult, mkRequest, mkUrl, unitResult) +import Quasar.URI as URI type M r = Free (Coproduct (CF.ConfigF (Config r)) (AXF.AffjaxFP RequestContent String)) diff --git a/src/Quasar/Advanced/QuasarAF/Interpreter/Internal.purs b/src/Quasar/Advanced/QuasarAF/Interpreter/Internal.purs index d4e35ac..a8d672d 100644 --- a/src/Quasar/Advanced/QuasarAF/Interpreter/Internal.purs +++ b/src/Quasar/Advanced/QuasarAF/Interpreter/Internal.purs @@ -22,16 +22,16 @@ import Control.Monad.Free (Free) import Data.Either (Either(..)) import Data.Functor.Coproduct (Coproduct) import Data.Maybe (Maybe(..)) -import Pathy (rootDir) import Data.String as String -import Quasar.Data.URI as URI import Network.HTTP.Affjax.Request (RequestContent) import Network.HTTP.AffjaxF as AXF +import Pathy (rootDir) import Quasar.Advanced.Paths as Paths import Quasar.Advanced.QuasarAF (GroupPath(..)) import Quasar.Advanced.QuasarAF.Interpreter.Config (Config) import Quasar.ConfigF as CF import Quasar.QuasarF.Interpreter.Internal (mkFSUrl) +import Quasar.URI as URI type AXFP = AXF.AffjaxFP RequestContent String diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index 5602a55..15aebde 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -29,16 +29,15 @@ import Control.Monad.Rec.Class (class MonadRec) import Data.Char.Gen as CG import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) -import Data.String as S import Data.String.Gen as SG import Data.String.NonEmpty (NonEmptyString, cons) import Data.String.NonEmpty as NES import Data.These (These(..)) -import Data.URI.Host.IPv4Address (fromInts) as IPv4Address -import Data.URI.Host.RegName as RegName -import Data.URI.Port as Port import Pathy.Gen (genAbsDirPath, genAbsFilePath) as PGen -import Quasar.Data.URI as URI +import Quasar.URI as URI +import URI.Host.Gen as HostGen +import URI.Host.RegName as RegName +import URI.Port as Port genAlphaNumericString ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m String genAlphaNumericString = SG.genString genAlphaNumericChar @@ -52,12 +51,7 @@ genAlphaNumericChar = Gen.oneOf $ CG.genDigitChar :| [CG.genAlpha] genHostURI ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.Host genHostURI = Gen.oneOf $ genIPv4 :| [genName] where - genIPv4 = filtered do - a ← Gen.chooseInt 1 254 - b ← Gen.chooseInt 1 254 - c ← Gen.chooseInt 1 254 - d ← Gen.chooseInt 1 254 - pure $ URI.IPv4Address <$> IPv4Address.fromInts a b c d + genIPv4 = URI.IPv4Address <$> HostGen.genIPv4 genName = URI.NameAddress <$> genRegName genRegName = do head ← CG.genAlpha diff --git a/src/Quasar/Mount/Couchbase.purs b/src/Quasar/Mount/Couchbase.purs index be5d95b..ccf1ebe 100644 --- a/src/Quasar/Mount/Couchbase.purs +++ b/src/Quasar/Mount/Couchbase.purs @@ -31,14 +31,14 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Newtype (un) import Data.Number as Num -import Data.StrMap as SM import Data.String.NonEmpty (NonEmptyString) +import Data.StrMap as SM import Data.Time.Duration (Seconds(..)) import Data.Tuple (Tuple(..)) -import Data.URI.Scheme as Scheme import Pathy (Name(..), ()) import Pathy as P -import Quasar.Data.URI as URI +import Quasar.URI as URI +import URI.Scheme as Scheme type Config = { host ∷ URI.QURIHost @@ -87,7 +87,7 @@ toURI { host, bucketName, password, docTypeKey, queryTimeout } = ] <> maybe [] (pure <<< Tuple "queryTimeoutSeconds" <<< Just <<< show <<< un Seconds) queryTimeout fromURI ∷ URI.QAbsoluteURI → Either String Config -fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartNoAuth path) query) = +fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartNoAuth path) query) = Left "Expected 'auth' part in URI" fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ host) path) query) = do unless (scheme == uriScheme) $ Left "Expected 'couchbase' URL scheme" @@ -108,4 +108,3 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ host) uriScheme ∷ URI.Scheme uriScheme = Scheme.unsafeFromString "couchbase" - diff --git a/src/Quasar/Mount/MarkLogic.purs b/src/Quasar/Mount/MarkLogic.purs index 11c7720..6552fff 100644 --- a/src/Quasar/Mount/MarkLogic.purs +++ b/src/Quasar/Mount/MarkLogic.purs @@ -32,9 +32,9 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe) import Data.StrMap as SM import Data.Tuple (Tuple(..)) -import Data.URI.Scheme as Scheme import Pathy (AbsPath) -import Quasar.Data.URI as URI +import Quasar.URI as URI +import URI.Scheme as Scheme type Config = { host ∷ URI.QURIHost diff --git a/src/Quasar/Mount/MongoDB.purs b/src/Quasar/Mount/MongoDB.purs index 0d4f6db..3095702 100644 --- a/src/Quasar/Mount/MongoDB.purs +++ b/src/Quasar/Mount/MongoDB.purs @@ -34,9 +34,9 @@ import Data.Foldable (null) import Data.Maybe (Maybe(..), maybe) import Data.Newtype (class Newtype, unwrap) import Data.StrMap as SM -import Data.URI.Scheme as Scheme import Pathy as P -import Quasar.Data.URI as URI +import Quasar.URI as URI +import URI.Scheme as Scheme newtype Auth = Auth { path ∷ P.AbsPath, credentials ∷ URI.UserPassInfo } diff --git a/src/Quasar/Mount/SparkHDFS.purs b/src/Quasar/Mount/SparkHDFS.purs index f1813bb..44bf68f 100644 --- a/src/Quasar/Mount/SparkHDFS.purs +++ b/src/Quasar/Mount/SparkHDFS.purs @@ -32,11 +32,11 @@ import Data.Either (Either(..), note) import Data.Maybe (Maybe(..), maybe) import Data.StrMap as SM import Data.Tuple (Tuple(..)) -import Data.URI.Scheme as Scheme import Global (encodeURIComponent, decodeURIComponent) import Pathy (AbsDir) -import Quasar.Data.URI as URI import Quasar.Types (parseQDirPath, printQPath) +import Quasar.URI as URI +import URI.Scheme as Scheme type Config = { sparkHost ∷ URI.QURIHost @@ -63,7 +63,7 @@ toURI cfg = mkURI sparkURIScheme cfg.sparkHost (Just (URI.QueryPairs $ requiredProps <> optionalProps)) where requiredProps ∷ Array (Tuple String (Maybe String)) - requiredProps = + requiredProps = [ Tuple "hdfsUrl" $ Just $ encodeURIComponent $ encode URI.qAbsoluteURI $ mkURI hdfsURIScheme cfg.hdfsHost Nothing , Tuple "rootPath" $ Just $ printQPath cfg.path ] diff --git a/src/Quasar/Mount/View.purs b/src/Quasar/Mount/View.purs index 074309c..73c287b 100644 --- a/src/Quasar/Mount/View.purs +++ b/src/Quasar/Mount/View.purs @@ -24,16 +24,16 @@ import Data.Codec (decode, encode) import Data.Either (Either(..), note) import Data.Foldable (foldMap) import Data.Maybe (Maybe(..), maybe) -import Data.StrMap as SM import Data.String as Str +import Data.StrMap as SM import Data.Tuple (Tuple(..), lookup) -import Data.URI.Scheme as Scheme -import Quasar.Data.URI as URI import Quasar.Types (Vars) +import Quasar.URI as URI import SqlSquared (SqlQuery) import SqlSquared as Sql import Text.Parsing.Parser (ParseError(..)) import Text.Parsing.Parser.Pos (Position(..)) +import URI.Scheme as Scheme type Config = { query ∷ SqlQuery diff --git a/src/Quasar/QuasarF/Interpreter/Affjax.purs b/src/Quasar/QuasarF/Interpreter/Affjax.purs index 5409b86..3e6b305 100644 --- a/src/Quasar/QuasarF/Interpreter/Affjax.purs +++ b/src/Quasar/QuasarF/Interpreter/Affjax.purs @@ -37,8 +37,8 @@ import Data.Maybe (Maybe(..)) import Data.MediaType.Common (applicationJSON) import Data.Monoid (mempty) import Data.Newtype (un) -import Data.StrMap as SM import Data.String.NonEmpty (toString) +import Data.StrMap as SM import Data.Time.Duration (Seconds(..)) import Data.Tuple (Tuple(..), fst, snd) import Network.HTTP.Affjax.Request (RequestContent, toRequest) @@ -48,7 +48,6 @@ import Pathy (Name(..), AbsDir, peel, peelFile, rootDir) import Quasar.ConfigF as CF import Quasar.Data.Json as Json import Quasar.Data.MediaTypes (applicationZip) -import Quasar.Data.URI as URI import Quasar.FS.DirMetadata as DirMetadata import Quasar.Metastore as Metastore import Quasar.Mount as Mount @@ -60,6 +59,7 @@ import Quasar.Query.OutputMeta as QueryOutputMeta import Quasar.ServerInfo as ServerInfo import Quasar.Types (printQPath) import Quasar.Types as QT +import Quasar.URI as URI import SqlSquared as Sql type M r = Free (Coproduct (CF.ConfigF (Config r)) (AXF.AffjaxFP RequestContent String)) diff --git a/src/Quasar/QuasarF/Interpreter/Config.purs b/src/Quasar/QuasarF/Interpreter/Config.purs index 898d95d..4765942 100644 --- a/src/Quasar/QuasarF/Interpreter/Config.purs +++ b/src/Quasar/QuasarF/Interpreter/Config.purs @@ -19,7 +19,7 @@ module Quasar.QuasarF.Interpreter.Config where import Data.Either (Either) import Data.Maybe (Maybe) import Pathy (AbsDir, RelDir) -import Quasar.Data.URI as URI +import Quasar.URI as URI type AbsBasePath = { scheme ∷ URI.Scheme, authority ∷ Maybe URI.QAuthority, path ∷ AbsDir } type BasePath = Either AbsBasePath RelDir diff --git a/src/Quasar/QuasarF/Interpreter/Internal.purs b/src/Quasar/QuasarF/Interpreter/Internal.purs index 5d8c6c5..66204ac 100644 --- a/src/Quasar/QuasarF/Interpreter/Internal.purs +++ b/src/Quasar/QuasarF/Interpreter/Internal.purs @@ -45,8 +45,8 @@ import Data.Functor.Coproduct (Coproduct, left, right) import Data.HTTP.Method (Method(..)) import Data.Maybe (Maybe(..), fromMaybe) import Data.Monoid (mempty) -import Data.StrMap as SM import Data.String as Str +import Data.StrMap as SM import Data.Tuple (Tuple(..)) import Network.HTTP.Affjax as AX import Network.HTTP.Affjax.Request (RequestContent) @@ -55,9 +55,9 @@ import Network.HTTP.ResponseHeader as RH import Network.HTTP.StatusCode (StatusCode(..)) import Pathy (class IsDirOrFile, Abs, AbsPath, Path, Rel, RelDir, RelPath, relativeTo, rootDir, ()) import Quasar.ConfigF as CF -import Quasar.Data.URI as URI import Quasar.QuasarF (Pagination, QError(..), PDFError(..), UnauthorizedDetails(..)) import Quasar.QuasarF.Interpreter.Config (Config) +import Quasar.URI as URI type AXFP = AXF.AffjaxFP RequestContent String type AjaxM r a = Free (Coproduct (CF.ConfigF (Config r)) AXFP) a @@ -102,7 +102,7 @@ mkFSUrl → AbsPath → URI.QQuery → AjaxM r String -mkFSUrl relDir fsPath q = mkUrl (bimap baseify baseify fsPath) q +mkFSUrl relDir fsPath q = mkUrl (bimap baseify baseify fsPath) q where baseify ∷ ∀ b. IsDirOrFile b => Path Abs b → Path Rel b baseify p = relDir p `relativeTo` rootDir @@ -125,7 +125,7 @@ mkUrl' relPath q = do in URI.URI scheme hierPart query Nothing toRelativeRef :: RelDir -> URI.QRelativeRef - toRelativeRef relDir = + toRelativeRef relDir = URI.RelativeRef (URI.RelativePartNoAuth (Just $ Right (bimap (relDir _) (relDir _) relPath))) diff --git a/src/Quasar/Data/URI.purs b/src/Quasar/URI.purs similarity index 83% rename from src/Quasar/Data/URI.purs rename to src/Quasar/URI.purs index 1d368b9..ddba66a 100644 --- a/src/Quasar/Data/URI.purs +++ b/src/Quasar/URI.purs @@ -14,7 +14,7 @@ See the License for the specific language governing permissions and limitations under the License. -} -module Quasar.Data.URI +module Quasar.URI ( QAbsoluteURI , qAbsoluteURI , MongoURI @@ -45,39 +45,39 @@ import Data.List (List(..), reverse) import Data.Maybe (Maybe(..), maybe) import Data.Newtype (un) import Data.Record.Builder as Builder -import Data.String.NonEmpty (NonEmptyString, fromString) +import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES import Data.Tuple (Tuple(..)) -import Data.URI (PathAbsolute, PathRootless) -import Data.URI (URI(..), RelativePart(..), Authority(..), AbsoluteURI(..), HierarchicalPart(..), HierPath, Host(..), Path(..), Port, RelativeRef(..), URIRef, Fragment, Query, UserInfo) as URI -import Data.URI.AbsoluteURI (AbsoluteURIOptions) as URI -import Data.URI.AbsoluteURI (print, parser) as AbsoluteURI -import Data.URI.Common (URIPartParseError(..)) -import Data.URI.Extra.MultiHostPortPair (MultiHostPortPair) as URI -import Data.URI.Extra.MultiHostPortPair (print, parser) as MultiHostPortPair -import Data.URI.Extra.QueryPairs (QueryPairs(..), Key, Value) as URI -import Data.URI.Extra.QueryPairs (print, parse, keyToString, valueToString, keyFromString, valueFromString) as QueryPairs -import Data.URI.Extra.UserPassInfo (UserPassInfo(..)) as URI -import Data.URI.Extra.UserPassInfo (print, parse) as UserPassInfo -import Data.URI.HostPortPair (HostPortPair) as URI -import Data.URI.HostPortPair (print, parser) as HostPortPair -import Data.URI.Path (Path) -import Data.URI.Path (print) as Path -import Data.URI.Path.Absolute (print, PathAbsolute(..)) as PathAbsolute -import Data.URI.Path.NoScheme (print, PathNoScheme(..)) as PathNoScheme -import Data.URI.Path.Rootless (print) as PathRootless -import Data.URI.Path.Segment (PathSegment, PathSegmentNZ, segmentFromString, unsafeSegmentNZFromString, unsafeSegmentNZNCFromString) -import Data.URI.RelativeRef (RelativeRefOptions) as URI -import Data.URI.RelativeRef (print, parser, RelPath) as RelativeRef -import Data.URI.Scheme (Scheme) as URI -import Data.URI.URI (URIOptions) as URI -import Data.URI.URIRef (URIRefOptions) as URI -import Data.URI.URIRef (print, parser) as URIRef import Partial.Unsafe (unsafeCrashWith) import Pathy (Name(..), foldPath, posixParser) import Pathy as Py import Text.Parsing.Parser (ParseError, Parser, runParser) import Type.Row (class RowListNub, class RowToList) +import URI (PathAbsolute, PathRootless) +import URI (URI(..), RelativePart(..), Authority(..), AbsoluteURI(..), HierarchicalPart(..), HierPath, Host(..), Path(..), Port, RelativeRef(..), URIRef, Fragment, Query, UserInfo) as URI +import URI.AbsoluteURI (AbsoluteURIOptions) as URI +import URI.AbsoluteURI (print, parser) as AbsoluteURI +import URI.Common (URIPartParseError(..)) +import URI.Extra.MultiHostPortPair (MultiHostPortPair) as URI +import URI.Extra.MultiHostPortPair (print, parser) as MultiHostPortPair +import URI.Extra.QueryPairs (print, parse, keyToString, valueToString, keyFromString, valueFromString) as QueryPairs +import URI.Extra.QueryPairs (QueryPairs(..), Key, Value) as URI +import URI.Extra.UserPassInfo (print, parse) as UserPassInfo +import URI.Extra.UserPassInfo (UserPassInfo(..)) as URI +import URI.HostPortPair (HostPortPair) as URI +import URI.HostPortPair (print, parser) as HostPortPair +import URI.Path (Path) +import URI.Path (print) as Path +import URI.Path.Absolute (print, PathAbsolute(..)) as PathAbsolute +import URI.Path.NoScheme (print, PathNoScheme(..)) as PathNoScheme +import URI.Path.Rootless (print) as PathRootless +import URI.Path.Segment (PathSegment, PathSegmentNZ, segmentFromString, unsafeSegmentNZFromString, unsafeSegmentNZNCFromString) +import URI.RelativeRef (print, parser, RelPath) as RelativeRef +import URI.RelativeRef (RelativeRefOptions) as URI +import URI.Scheme (Scheme) as URI +import URI.URI (URIOptions) as URI +import URI.URIRef (print, parser) as URIRef +import URI.URIRef (URIRefOptions) as URI type AbsPath = Py.AbsPath type AnyPath = Either Py.AbsPath Py.RelPath @@ -124,7 +124,7 @@ qURIRef = basicCodec (flip runParser $ URIRef.parser opts.uriRef) (URIRef.print opts.uriRef) -opts :: +opts :: { absoluteURI ∷ Record QAbsoluteURIOptions , mongoURI ∷ Record MongoURIOptions , relativeRef ∷ Record QRelativeRefOptions @@ -162,7 +162,7 @@ opts = parseHost = HostPortPair.parser pure pure printHost :: QURIHost -> String printHost = HostPortPair.print id id - + parseHosts :: Parser String QURIHosts parseHosts = MultiHostPortPair.parser pure pure printHosts :: QURIHosts -> String @@ -175,10 +175,10 @@ opts = Left d -> URI.Path $ (fromFoldable d <#> runName >>> segmentFromString) <> [ segmentFromString "" ] - Right (Tuple d n) -> + Right (Tuple d n) -> URI.Path $ (fromFoldable d <#> asSegment) <> [asSegment n] - + parseHierPath :: Either PathAbsolute PathRootless -> Either URIPartParseError AbsPath parseHierPath = _parseAbsPath <<< either PathAbsolute.print PathRootless.print @@ -207,9 +207,9 @@ opts = Nil -> PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ n) [] Cons head tail -> PathAbsolute.PathAbsolute $ Just - $ Tuple (asSegmentNZ head) + $ Tuple (asSegmentNZ head) $ (asSegment <$> fromFoldable tail) <> [ asSegment n ] - + _printRelPath :: Py.RelPath → PathNoScheme.PathNoScheme _printRelPath = bimap viewRelDir viewRelFile >>> case _ of Left Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString currentDirSegment) [] @@ -254,7 +254,7 @@ opts = >>> note (URIPartParseError "Could not parse valid relative path") -- Union which rejects duplicates -union +union :: forall r1 r2 r3 r3l . Union r1 r2 r3 => RowToList r3 r3l @@ -268,7 +268,7 @@ asSegmentNZ :: forall a. Py.Name a -> PathSegmentNZ asSegmentNZ = un Py.Name >>> unsafeSegmentNZFromString asSegment :: forall a. Py.Name a -> PathSegment -asSegment = runName >>> segmentFromString +asSegment = runName >>> segmentFromString runName :: forall a. Py.Name a -> String runName = un Py.Name >>> NES.toString @@ -293,4 +293,3 @@ viewRelDir = reverse <<< go viewRelFile :: Py.Path Py.Rel Py.File -> Tuple (List (Maybe (Py.Name Py.Dir))) (Py.Name Py.File) viewRelFile = Py.peelFile >>> lmap viewRelDir - diff --git a/test/src/Test/Main.purs b/test/src/Test/Main.purs index 6915a8d..fbc1276 100644 --- a/test/src/Test/Main.purs +++ b/test/src/Test/Main.purs @@ -41,9 +41,9 @@ import Data.String.NonEmpty as NES import Data.Symbol (SProxy(..)) import Data.These (These(..)) import Data.Tuple (Tuple(..)) -import Data.URI.Host.RegName as RegName -import Data.URI.Port as Port -import Data.URI.Scheme as Scheme +import URI.Host.RegName as RegName +import URI.Port as Port +import URI.Scheme as Scheme import Network.HTTP.Affjax (AJAX) import Node.ChildProcess as CP import Node.Encoding (Encoding(..)) @@ -56,7 +56,7 @@ import Pathy (rootDir, dir, file, ()) import Quasar.Advanced.QuasarAF.Interpreter.Aff (Config, eval) import Quasar.Data (QData(..)) import Quasar.Data.Json as Json -import Quasar.Data.URI as URI +import Quasar.URI as URI import Quasar.Mount (MountConfig(..)) import Quasar.QuasarF (QuasarF, QError(..)) import Quasar.QuasarF as QF diff --git a/test/src/Test/Unit/Main.purs b/test/src/Test/Unit/Main.purs index f5948a5..10a7832 100644 --- a/test/src/Test/Unit/Main.purs +++ b/test/src/Test/Unit/Main.purs @@ -29,10 +29,10 @@ import Data.String.NonEmpty (fromString) import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.Time.Duration (Seconds(..)) -import Data.URI.Host.RegName as RegName -import Data.URI.Port as Port +import URI.Host.RegName as RegName +import URI.Port as Port import Partial.Unsafe (unsafePartial) -import Quasar.Data.URI as URI +import Quasar.URI as URI import Quasar.Mount as QM import Quasar.Mount.Couchbase as CB import Quasar.Mount.MongoDB as Mongo @@ -63,9 +63,9 @@ main = do }) testURIParse (map CBT.TestConfig <$> CB.fromURI) - "couchbase://localhost:99999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" + "couchbase://localhost:9999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (CBT.TestConfig - { host: Just $ Both (URI.NameAddress $ RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost") (Port.unsafeFromInt 99999) + { host: Just $ Both (URI.NameAddress $ RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost") (Port.unsafeFromInt 9999) , bucketName: fromString "testBucket" , password: "pass" , docTypeKey: "type" From 9b96b1ffa601934688503ca493a130ef4ff0c05e Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Wed, 28 Feb 2018 16:21:28 +0000 Subject: [PATCH 17/33] Unicode --- src/Quasar/Advanced/Paths.purs | 22 ++-- src/Quasar/Advanced/Types.purs | 18 ++-- src/Quasar/FS/Mount.purs | 10 +- src/Quasar/FS/Mount/Gen.purs | 4 +- src/Quasar/FS/Resource/Gen.purs | 4 +- src/Quasar/Mount/Common/Gen.purs | 16 +-- src/Quasar/Mount/Couchbase.purs | 8 +- src/Quasar/Mount/Gen.purs | 2 +- src/Quasar/Paths.purs | 18 ++-- src/Quasar/QuasarF/Interpreter/Affjax.purs | 8 +- src/Quasar/QuasarF/Interpreter/Internal.purs | 8 +- src/Quasar/Types.purs | 6 +- src/Quasar/URI.purs | 106 +++++++++---------- test/src/Test/Implementation.purs | 2 +- test/src/Test/Main.purs | 20 ++-- test/src/Test/Unit/Main.purs | 4 +- test/src/Util/Effect.purs | 19 ++-- 17 files changed, 136 insertions(+), 139 deletions(-) diff --git a/src/Quasar/Advanced/Paths.purs b/src/Quasar/Advanced/Paths.purs index 5e7b956..b983535 100644 --- a/src/Quasar/Advanced/Paths.purs +++ b/src/Quasar/Advanced/Paths.purs @@ -20,33 +20,31 @@ import Pathy (RelDir, RelFile, dir, file, ()) import Data.Symbol (SProxy(..)) oidcProviders ∷ RelFile -oidcProviders = dir (SProxy :: SProxy "security") dir (SProxy :: SProxy "oidc") file (SProxy :: SProxy "providers") +oidcProviders = dir (SProxy ∷ SProxy "security") dir (SProxy ∷ SProxy "oidc") file (SProxy ∷ SProxy "providers") token ∷ RelDir -token = dir (SProxy :: SProxy "security") dir (SProxy :: SProxy "token") +token = dir (SProxy ∷ SProxy "security") dir (SProxy ∷ SProxy "token") group ∷ RelDir -group = dir (SProxy :: SProxy "security") dir (SProxy :: SProxy "group") +group = dir (SProxy ∷ SProxy "security") dir (SProxy ∷ SProxy "group") permission ∷ RelDir -permission = dir (SProxy :: SProxy "security") dir (SProxy :: SProxy "permission") +permission = dir (SProxy ∷ SProxy "security") dir (SProxy ∷ SProxy "permission") children ∷ RelFile -children = file (SProxy :: SProxy "children") +children = file (SProxy ∷ SProxy "children") authority ∷ RelDir -authority = dir (SProxy :: SProxy "security") dir (SProxy :: SProxy "authority") +authority = dir (SProxy ∷ SProxy "security") dir (SProxy ∷ SProxy "authority") licenseInfo ∷ RelFile -licenseInfo = dir (SProxy :: SProxy "server") file (SProxy :: SProxy "licenseInfo") +licenseInfo = dir (SProxy ∷ SProxy "server") file (SProxy ∷ SProxy "licenseInfo") licensee ∷ RelFile -licensee = dir (SProxy :: SProxy "server") file (SProxy :: SProxy "licensee") +licensee = dir (SProxy ∷ SProxy "server") file (SProxy ∷ SProxy "licensee") pdfInfo ∷ RelFile -pdfInfo = dir (SProxy :: SProxy "service") dir (SProxy :: SProxy "pdf") file (SProxy :: SProxy "info") +pdfInfo = dir (SProxy ∷ SProxy "service") dir (SProxy ∷ SProxy "pdf") file (SProxy ∷ SProxy "info") generatePdf ∷ RelFile -generatePdf = dir (SProxy :: SProxy "service") dir (SProxy :: SProxy "pdf") file (SProxy :: SProxy "generate") - - +generatePdf = dir (SProxy ∷ SProxy "service") dir (SProxy ∷ SProxy "pdf") file (SProxy ∷ SProxy "generate") diff --git a/src/Quasar/Advanced/Types.purs b/src/Quasar/Advanced/Types.purs index f71632d..6439e35 100644 --- a/src/Quasar/Advanced/Types.purs +++ b/src/Quasar/Advanced/Types.purs @@ -166,15 +166,15 @@ instance encodeJsonUserId ∷ EncodeJson UserId where instance decodeJsonUserId ∷ DecodeJson UserId where decodeJson = map UserId <<< decodeNEString -encodeNEString :: NonEmptyString -> Json +encodeNEString ∷ NonEmptyString → Json encodeNEString = encodeJson <<< toString -decodeNEString :: Json -> Either String NonEmptyString +decodeNEString ∷ Json → Either String NonEmptyString decodeNEString j = do - str <- decodeJson j + str ← decodeJson j case fromString str of - Nothing -> Left "Expected string to be non empty" - Just a -> pure a + Nothing → Left "Expected string to be non empty" + Just a → pure a newtype TokenId = TokenId NonEmptyString @@ -237,18 +237,18 @@ instance decodeJsonGrantedTo ∷ DecodeJson GrantedTo where parseUserId ∷ String → Either String UserId parseUserId str = Str.stripPrefix (Str.Pattern "user:") str - >>= fromString + >>= fromString # map UserId # note "Could not parse user" - + parseTokenId ∷ String → Either String TokenId parseTokenId str = Str.stripPrefix (Str.Pattern "token:") str - >>= fromString + >>= fromString # map TokenId # note "Could not parse token" - + parseGroup ∷ String → Either String GroupPath parseGroup string = diff --git a/src/Quasar/FS/Mount.purs b/src/Quasar/FS/Mount.purs index 0230f54..8d3c326 100644 --- a/src/Quasar/FS/Mount.purs +++ b/src/Quasar/FS/Mount.purs @@ -99,7 +99,7 @@ instance ordMount ∷ Ord1 f ⇒ Ord (MountF f) where instance showMount ∷ (Show (f TS.TacitString), Functor f) ⇒ Show (MountF f) where show = let - show' :: forall a. Show a ⇒ f a → String + show' ∷ ∀ a. Show a ⇒ f a → String show' = map (show >>> TS.hush) >>> show in case _ of View p → "(View " <> show' p <> ")" @@ -120,13 +120,13 @@ fromJSON parent = decodeJson >=> \obj → do typ ← obj .? "type" name' ← note "empty name" <<< fromString =<< (obj .? "name") let - err :: forall a. Either String a + err ∷ ∀ a. Either String a err = Left $ "Unexpected type '" <> typ <> "' for mount '" <> mount <> "'" - onFile :: Either String (Identity AbsFile) + onFile ∷ Either String (Identity AbsFile) onFile = if typ == "file" then Right $ Identity $ parent file' (Name name') else err - onDir :: Either String (Identity AbsDir) + onDir ∷ Either String (Identity AbsDir) onDir = if typ == "directory" then Right $ Identity $ parent dir' (Name name') else err - onAnyPath :: Either String (Identity AbsPath) + onAnyPath ∷ Either String (Identity AbsPath) onAnyPath = map (map Left) onDir <|> map (map Right) onFile case typeFromName mount of View _ → View <$> onFile diff --git a/src/Quasar/FS/Mount/Gen.purs b/src/Quasar/FS/Mount/Gen.purs index b3c62fa..7604067 100644 --- a/src/Quasar/FS/Mount/Gen.purs +++ b/src/Quasar/FS/Mount/Gen.purs @@ -31,7 +31,7 @@ import Quasar.FS.Mount (MountF(..), Mount, MountType) import Quasar.Mount.Common.Gen (genAbsDirPath, genAbsFilePath) -genMountType :: ∀ m. MonadGen m ⇒ MonadRec m ⇒ m MountType +genMountType ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m MountType genMountType = Gen.oneOf $ (pure $ View $ Const unit) :| [ pure $ Module $ Const unit @@ -44,7 +44,7 @@ genMountType = Gen.oneOf , genUnicodeString <#> (_ `Unknown` Const unit) ] -genMount :: ∀ m. MonadGen m ⇒ MonadRec m ⇒ m Mount +genMount ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m Mount genMount = Gen.oneOf $ (genAbsFilePath <#> Identity >>> View) :| [ genAbsDirPath <#> Identity >>> Module diff --git a/src/Quasar/FS/Resource/Gen.purs b/src/Quasar/FS/Resource/Gen.purs index 60534f5..60472f1 100644 --- a/src/Quasar/FS/Resource/Gen.purs +++ b/src/Quasar/FS/Resource/Gen.purs @@ -29,9 +29,9 @@ import Quasar.FS.Resource (QResource(..)) import Quasar.Mount.Common.Gen (genAbsDirPath, genAbsFilePath) -genQResource :: ∀ m. MonadGen m ⇒ MonadRec m ⇒ m QResource +genQResource ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m QResource genQResource = Gen.frequency $ (Tuple 1.0 $ genAbsFilePath <#> File ) :| - [ Tuple 1.0 $ genAbsDirPath <#> Directory + [ Tuple 1.0 $ genAbsDirPath <#> Directory , Tuple 3.0 $ genMount <#> Mount ] diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index 15aebde..f8a90b9 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -58,7 +58,7 @@ genHostURI = Gen.oneOf $ genIPv4 :| [genName] tail ← genAlphaNumericString pure $ RegName.fromString $ NES.cons head tail -genPort ∷ ∀ m. MonadRec m => MonadGen m ⇒ m URI.Port +genPort ∷ ∀ m. MonadRec m ⇒ MonadGen m ⇒ m URI.Port genPort = filtered $ Port.fromInt <$> Gen.chooseInt 50000 65535 genHost ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.QURIHost @@ -67,15 +67,15 @@ genHost = genMaybe $ genThese genHostURI genPort genHosts ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.QURIHosts genHosts = Gen.unfoldable $ genThese genHostURI genPort -genThese ∷ ∀ m a b. MonadGen m ⇒ MonadRec m ⇒ m a -> m b -> m (These a b) +genThese ∷ ∀ m a b. MonadGen m ⇒ MonadRec m ⇒ m a → m b → m (These a b) genThese ma mb = filtered do - a' <- GenC.genMaybe ma - b' <- GenC.genMaybe mb + a' ← GenC.genMaybe ma + b' ← GenC.genMaybe mb pure case a', b' of - Just a, Just b -> Just $ Both a b - Just a, Nothing -> Just $ This a - Nothing, Just b -> Just $ That b - Nothing, Nothing -> Nothing + Just a, Just b → Just $ Both a b + Just a, Nothing → Just $ This a + Nothing, Just b → Just $ That b + Nothing, Nothing → Nothing genCredentials ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.UserPassInfo genCredentials = diff --git a/src/Quasar/Mount/Couchbase.purs b/src/Quasar/Mount/Couchbase.purs index ccf1ebe..dd1f7b5 100644 --- a/src/Quasar/Mount/Couchbase.purs +++ b/src/Quasar/Mount/Couchbase.purs @@ -68,16 +68,16 @@ toURI { host, bucketName, password, docTypeKey, queryTimeout } = hierarchicalPart (Just (URI.QueryPairs props)) where - hierarchicalPart :: URI.QHierarchicalPart + hierarchicalPart ∷ URI.QHierarchicalPart hierarchicalPart = URI.HierarchicalPartAuth authority (case bucketName of - Nothing -> Just $ Left P.rootDir - Just n -> Just $ Right $ P.rootDir P.file' (Name n) + Nothing → Just $ Left P.rootDir + Just n → Just $ Right $ P.rootDir P.file' (Name n) ) - authority :: URI.QAuthority + authority ∷ URI.QAuthority authority = URI.Authority Nothing host props ∷ Array (Tuple String (Maybe String)) diff --git a/src/Quasar/Mount/Gen.purs b/src/Quasar/Mount/Gen.purs index 2a86f06..b8fa851 100644 --- a/src/Quasar/Mount/Gen.purs +++ b/src/Quasar/Mount/Gen.purs @@ -33,7 +33,7 @@ import Quasar.Mount.Unknown.Gen as Unknown import Quasar.Mount.Module.Gen as Module import Quasar.Mount.View.Gen as View -genMountConfig :: ∀ m. MonadGen m ⇒ MonadRec m ⇒ m MountConfig +genMountConfig ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m MountConfig genMountConfig = Gen.oneOf $ (MongoDBConfig <$> MongoDB.genConfig) :| [ CouchbaseConfig <$> Couchbase.genConfig diff --git a/src/Quasar/Paths.purs b/src/Quasar/Paths.purs index b8f5a5b..6ca55ae 100644 --- a/src/Quasar/Paths.purs +++ b/src/Quasar/Paths.purs @@ -20,28 +20,28 @@ import Pathy (RelDir, RelFile, file, dir, ()) import Data.Symbol (SProxy(..)) upload ∷ RelFile -upload = file (SProxy :: SProxy "upload") +upload = file (SProxy ∷ SProxy "upload") metadata ∷ RelDir -metadata = dir (SProxy :: SProxy "metadata") dir (SProxy :: SProxy "fs") +metadata = dir (SProxy ∷ SProxy "metadata") dir (SProxy ∷ SProxy "fs") metastore ∷ RelFile -metastore = file (SProxy :: SProxy "metastore") +metastore = file (SProxy ∷ SProxy "metastore") mount ∷ RelDir -mount = dir (SProxy :: SProxy "mount") dir (SProxy :: SProxy "fs") +mount = dir (SProxy ∷ SProxy "mount") dir (SProxy ∷ SProxy "fs") data_ ∷ RelDir -data_ = dir (SProxy :: SProxy "data") dir (SProxy :: SProxy "fs") +data_ = dir (SProxy ∷ SProxy "data") dir (SProxy ∷ SProxy "fs") query ∷ RelDir -query = dir (SProxy :: SProxy "query") dir (SProxy :: SProxy "fs") +query = dir (SProxy ∷ SProxy "query") dir (SProxy ∷ SProxy "fs") compile ∷ RelDir -compile = dir (SProxy :: SProxy "compile") dir (SProxy :: SProxy "fs") +compile = dir (SProxy ∷ SProxy "compile") dir (SProxy ∷ SProxy "fs") serverInfo ∷ RelFile -serverInfo = dir (SProxy :: SProxy "server") file (SProxy :: SProxy "info") +serverInfo = dir (SProxy ∷ SProxy "server") file (SProxy ∷ SProxy "info") invoke ∷ RelDir -invoke = dir (SProxy :: SProxy "invoke") dir (SProxy :: SProxy "fs") +invoke = dir (SProxy ∷ SProxy "invoke") dir (SProxy ∷ SProxy "fs") diff --git a/src/Quasar/QuasarF/Interpreter/Affjax.purs b/src/Quasar/QuasarF/Interpreter/Affjax.purs index 3e6b305..86979ff 100644 --- a/src/Quasar/QuasarF/Interpreter/Affjax.purs +++ b/src/Quasar/QuasarF/Interpreter/Affjax.purs @@ -166,9 +166,9 @@ eval = case _ of CreateMount path config mbMaxAge k → do let Tuple parentDir name = case bimap peel peelFile path of - Left Nothing -> Tuple rootDir "" - Left (Just dp) -> dp <#> un Name >>> toString >>> (_ <> "/") - Right fp -> fp <#> un Name >>> toString + Left Nothing → Tuple rootDir "" + Left (Just dp) → dp <#> un Name >>> toString >>> (_ <> "/") + Right fp → fp <#> un Name >>> toString url ← mkFSUrl Paths.mount (Left parentDir) (headerParams [Tuple "X-File-Name" name]) k <$> mkRequest unitResult (AXF.affjax defaultRequest @@ -201,7 +201,7 @@ eval = case _ of k <$> (mkRequest unitResult $ put url $ snd (toRequest (Metastore.toJSON metastore))) -serverInfoResult ∷ String -> Either Error ServerInfo.ServerInfo +serverInfoResult ∷ String → Either Error ServerInfo.ServerInfo serverInfoResult = lmap error <$> ServerInfo.fromJSON <=< jsonResult writeQueryResult ∷ String → Either Error QueryOutputMeta.OutputMeta diff --git a/src/Quasar/QuasarF/Interpreter/Internal.purs b/src/Quasar/QuasarF/Interpreter/Internal.purs index 66204ac..f982cd5 100644 --- a/src/Quasar/QuasarF/Interpreter/Internal.purs +++ b/src/Quasar/QuasarF/Interpreter/Internal.purs @@ -104,7 +104,7 @@ mkFSUrl → AjaxM r String mkFSUrl relDir fsPath q = mkUrl (bimap baseify baseify fsPath) q where - baseify ∷ ∀ b. IsDirOrFile b => Path Abs b → Path Rel b + baseify ∷ ∀ b. IsDirOrFile b ⇒ Path Abs b → Path Rel b baseify p = relDir p `relativeTo` rootDir mkUrl ∷ ∀ r. RelPath → URI.QQuery → AjaxM r String @@ -119,12 +119,12 @@ mkUrl' relPath q = do let hierPath = (Just (bimap (path _) (path _) relPath)) hierPart = case authority of - Nothing -> URI.HierarchicalPartNoAuth hierPath - Just authority' -> URI.HierarchicalPartAuth authority' hierPath + Nothing → URI.HierarchicalPartNoAuth hierPath + Just authority' → URI.HierarchicalPartAuth authority' hierPath query = if q == mempty then Nothing else Just q in URI.URI scheme hierPart query Nothing - toRelativeRef :: RelDir -> URI.QRelativeRef + toRelativeRef ∷ RelDir → URI.QRelativeRef toRelativeRef relDir = URI.RelativeRef (URI.RelativePartNoAuth diff --git a/src/Quasar/Types.purs b/src/Quasar/Types.purs index fb3a92d..09e3db7 100644 --- a/src/Quasar/Types.purs +++ b/src/Quasar/Types.purs @@ -26,13 +26,13 @@ import Data.StrMap (StrMap) import Data.Traversable (traverse) import Pathy (class IsDirOrFile, Abs, AbsDir, AbsFile, Path, parseAbsDir, parseAbsFile, posixParser, posixPrinter, printPath, sandboxAny) -printQPath :: forall b. IsDirOrFile b => Path Abs b -> String +printQPath ∷ ∀ b. IsDirOrFile b ⇒ Path Abs b → String printQPath = sandboxAny >>> printPath posixPrinter -parseQFilePath :: String -> Maybe AbsFile +parseQFilePath ∷ String → Maybe AbsFile parseQFilePath = parseAbsFile posixParser -parseQDirPath :: String -> Maybe AbsDir +parseQDirPath ∷ String → Maybe AbsDir parseQDirPath = parseAbsDir posixParser type Vars = StrMap String diff --git a/src/Quasar/URI.purs b/src/Quasar/URI.purs index ddba66a..b1b8d45 100644 --- a/src/Quasar/URI.purs +++ b/src/Quasar/URI.purs @@ -124,7 +124,7 @@ qURIRef = basicCodec (flip runParser $ URIRef.parser opts.uriRef) (URIRef.print opts.uriRef) -opts :: +opts ∷ { absoluteURI ∷ Record QAbsoluteURIOptions , mongoURI ∷ Record MongoURIOptions , relativeRef ∷ Record QRelativeRefOptions @@ -148,92 +148,92 @@ opts = _Fragment = { parseFragment, printFragment } _RelPath = { parseRelPath, printRelPath } - parseQuery :: URI.Query -> Either URIPartParseError QQuery + parseQuery ∷ URI.Query → Either URIPartParseError QQuery parseQuery = QueryPairs.parse (QueryPairs.keyToString >>> pure) (QueryPairs.valueToString >>> pure) - printQuery :: QQuery -> URI.Query + printQuery ∷ QQuery → URI.Query printQuery = QueryPairs.print QueryPairs.keyFromString QueryPairs.valueFromString - parseUserInfo :: URI.UserInfo -> Either URIPartParseError URI.UserPassInfo + parseUserInfo ∷ URI.UserInfo → Either URIPartParseError URI.UserPassInfo parseUserInfo = UserPassInfo.parse - printUserInfo :: URI.UserPassInfo -> URI.UserInfo + printUserInfo ∷ URI.UserPassInfo → URI.UserInfo printUserInfo = UserPassInfo.print - parseHost :: Parser String QURIHost + parseHost ∷ Parser String QURIHost parseHost = HostPortPair.parser pure pure - printHost :: QURIHost -> String + printHost ∷ QURIHost → String printHost = HostPortPair.print id id - parseHosts :: Parser String QURIHosts + parseHosts ∷ Parser String QURIHosts parseHosts = MultiHostPortPair.parser pure pure - printHosts :: QURIHosts -> String + printHosts ∷ QURIHosts → String printHosts = MultiHostPortPair.print id id - parsePath :: Path -> Either URIPartParseError AbsPath + parsePath ∷ Path → Either URIPartParseError AbsPath parsePath = _parseAbsPath <<< Path.print printPath ∷ AbsPath → Path printPath = bimap viewAbsDir viewAbsFile >>>case _ of - Left d -> + Left d → URI.Path $ (fromFoldable d <#> runName >>> segmentFromString) <> [ segmentFromString "" ] - Right (Tuple d n) -> + Right (Tuple d n) → URI.Path $ (fromFoldable d <#> asSegment) <> [asSegment n] - parseHierPath :: Either PathAbsolute PathRootless -> Either URIPartParseError AbsPath + parseHierPath ∷ Either PathAbsolute PathRootless → Either URIPartParseError AbsPath parseHierPath = _parseAbsPath <<< either PathAbsolute.print PathRootless.print printHierPath ∷ AbsPath → Either PathAbsolute PathRootless printHierPath = _printAbsPath >>> Left - parseFragment :: URI.Fragment -> Either URIPartParseError URI.Fragment + parseFragment ∷ URI.Fragment → Either URIPartParseError URI.Fragment parseFragment = Right - printFragment :: URI.Fragment -> URI.Fragment + printFragment ∷ URI.Fragment → URI.Fragment printFragment = id - printRelPath :: AnyPath -> RelativeRef.RelPath + printRelPath ∷ AnyPath → RelativeRef.RelPath printRelPath = bimap _printAbsPath _printRelPath - parseRelPath :: RelativeRef.RelPath -> Either URIPartParseError AnyPath + parseRelPath ∷ RelativeRef.RelPath → Either URIPartParseError AnyPath parseRelPath = bitraverse (PathAbsolute.print >>> _parseAbsPath) (PathNoScheme.print >>> _parseRelPath) - _printAbsPath :: Py.AbsPath → PathAbsolute + _printAbsPath ∷ Py.AbsPath → PathAbsolute _printAbsPath = bimap viewAbsDir viewAbsFile >>> case _ of - Left Nil -> PathAbsolute.PathAbsolute Nothing - Left (Cons head tail) -> PathAbsolute.PathAbsolute $ Just + Left Nil → PathAbsolute.PathAbsolute Nothing + Left (Cons head tail) → PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ head) $ (asSegment <$> fromFoldable tail) <> [ segmentFromString "" ] - Right (Tuple d n) -> case d of - Nil -> PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ n) [] - Cons head tail -> PathAbsolute.PathAbsolute + Right (Tuple d n) → case d of + Nil → PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ n) [] + Cons head tail → PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ head) $ (asSegment <$> fromFoldable tail) <> [ asSegment n ] - _printRelPath :: Py.RelPath → PathNoScheme.PathNoScheme + _printRelPath ∷ Py.RelPath → PathNoScheme.PathNoScheme _printRelPath = bimap viewRelDir viewRelFile >>> case _ of - Left Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString currentDirSegment) [] - Left (Cons head tail) -> + Left Nil → PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString currentDirSegment) [] + Left (Cons head tail) → PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ maybe parentDirSegment (un Name) head) $ (segmentFromString <<< maybe "../" runName <$> fromFoldable tail) <> [ segmentFromString "" ] - Right (Tuple d n) -> case d of - Nil -> PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ un Name n) [] - Cons head tail -> PathNoScheme.PathNoScheme + Right (Tuple d n) → case d of + Nil → PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ un Name n) [] + Cons head tail → PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ maybe parentDirSegment (un Name) head) $ (segmentFromString <<< maybe "../" runName <$> fromFoldable tail) <> [ asSegment n ] - currentDirSegment :: NonEmptyString + currentDirSegment ∷ NonEmptyString currentDirSegment = case NES.fromString "./" of - Nothing -> unsafeCrashWith "unreachable case in currentDirSegment" - Just a -> a - parentDirSegment :: NonEmptyString + Nothing → unsafeCrashWith "unreachable case in currentDirSegment" + Just a → a + parentDirSegment ∷ NonEmptyString parentDirSegment = case NES.fromString "../" of - Nothing -> unsafeCrashWith "unreachable case in parentDirSegment" - Just a -> a - _parseAbsPath :: String -> Either URIPartParseError Py.AbsPath + Nothing → unsafeCrashWith "unreachable case in parentDirSegment" + Just a → a + _parseAbsPath ∷ String → Either URIPartParseError Py.AbsPath _parseAbsPath = Py.parsePath posixParser (const Nothing) @@ -243,7 +243,7 @@ opts = Nothing >>> note (URIPartParseError "Could not parse valid absolute path") - _parseRelPath :: String -> Either URIPartParseError Py.RelPath + _parseRelPath ∷ String → Either URIPartParseError Py.RelPath _parseRelPath = Py.parsePath posixParser (Just <<< Left) @@ -255,41 +255,41 @@ opts = -- Union which rejects duplicates union - :: forall r1 r2 r3 r3l + ∷ ∀ r1 r2 r3 r3l . Union r1 r2 r3 - => RowToList r3 r3l - => RowListNub r3l r3l - => { | r1 } - -> { | r2 } - -> { | r3 } + ⇒ RowToList r3 r3l + ⇒ RowListNub r3l r3l + ⇒ { | r1 } + → { | r2 } + → { | r3 } union r1 r2 = Builder.build (Builder.merge r2) r1 -asSegmentNZ :: forall a. Py.Name a -> PathSegmentNZ +asSegmentNZ ∷ ∀ a. Py.Name a → PathSegmentNZ asSegmentNZ = un Py.Name >>> unsafeSegmentNZFromString -asSegment :: forall a. Py.Name a -> PathSegment +asSegment ∷ ∀ a. Py.Name a → PathSegment asSegment = runName >>> segmentFromString -runName :: forall a. Py.Name a -> String +runName ∷ ∀ a. Py.Name a → String runName = un Py.Name >>> NES.toString -viewAbsDir :: Py.Path Py.Abs Py.Dir -> List (Py.Name Py.Dir) +viewAbsDir ∷ Py.Path Py.Abs Py.Dir → List (Py.Name Py.Dir) viewAbsDir = reverse <<< go where go p = foldPath Nil - (\_ -> unsafeCrashWith "ParentOf node in viewDir") + (\_ → unsafeCrashWith "ParentOf node in viewDir") (flip Cons <<< go) p -viewAbsFile :: Py.Path Py.Abs Py.File -> Tuple (List (Py.Name Py.Dir)) (Py.Name Py.File) +viewAbsFile ∷ Py.Path Py.Abs Py.File → Tuple (List (Py.Name Py.Dir)) (Py.Name Py.File) viewAbsFile = Py.peelFile >>> lmap viewAbsDir -viewRelDir :: Py.Path Py.Rel Py.Dir -> List (Maybe (Py.Name Py.Dir)) +viewRelDir ∷ Py.Path Py.Rel Py.Dir → List (Maybe (Py.Name Py.Dir)) viewRelDir = reverse <<< go where go p' = foldPath Nil - (\p -> Cons Nothing (go p)) - (\p n -> Cons (Just n) (go p)) p' + (\p → Cons Nothing (go p)) + (\p n → Cons (Just n) (go p)) p' -viewRelFile :: Py.Path Py.Rel Py.File -> Tuple (List (Maybe (Py.Name Py.Dir))) (Py.Name Py.File) +viewRelFile ∷ Py.Path Py.Rel Py.File → Tuple (List (Maybe (Py.Name Py.Dir))) (Py.Name Py.File) viewRelFile = Py.peelFile >>> lmap viewRelDir diff --git a/test/src/Test/Implementation.purs b/test/src/Test/Implementation.purs index b1dd6e3..d264f1a 100644 --- a/test/src/Test/Implementation.purs +++ b/test/src/Test/Implementation.purs @@ -23,7 +23,7 @@ import Test.Property.Main as Prop import Test.QuickCheck (QC) import Test.Unit.Main as Unit -main ∷ forall eff. QC (assert ∷ ASSERT | eff) Unit +main ∷ ∀ eff. QC (assert ∷ ASSERT | eff) Unit main = do Prop.main Unit.main diff --git a/test/src/Test/Main.purs b/test/src/Test/Main.purs index fbc1276..bcdbb66 100644 --- a/test/src/Test/Main.purs +++ b/test/src/Test/Main.purs @@ -220,16 +220,16 @@ main = void $ runAff (const (pure unit)) $ jumpOutOnError do where testDbAnyDir = rootDir - nonexistant = rootDir file (SProxy :: SProxy "nonexistant") - testFile1 = rootDir file (SProxy :: SProxy "test1") - testFile2Dir = rootDir dir (SProxy :: SProxy "subdir") - testFile2 = testFile2Dir file (SProxy :: SProxy "test2") - testFile3Dir = rootDir dir (SProxy :: SProxy "what") - testFile3 = testFile3Dir file (SProxy :: SProxy "test2") - testMount = rootDir file (SProxy :: SProxy "testMount") - testMount2 = rootDir file (SProxy :: SProxy "testMount2") - testMount3 = rootDir dir (SProxy :: SProxy "testMount3") - testProcess = rootDir dir (SProxy :: SProxy "testMount3") file (SProxy :: SProxy "test") + nonexistant = rootDir file (SProxy ∷ SProxy "nonexistant") + testFile1 = rootDir file (SProxy ∷ SProxy "test1") + testFile2Dir = rootDir dir (SProxy ∷ SProxy "subdir") + testFile2 = testFile2Dir file (SProxy ∷ SProxy "test2") + testFile3Dir = rootDir dir (SProxy ∷ SProxy "what") + testFile3 = testFile3Dir file (SProxy ∷ SProxy "test2") + testMount = rootDir file (SProxy ∷ SProxy "testMount") + testMount2 = rootDir file (SProxy ∷ SProxy "testMount2") + testMount3 = rootDir dir (SProxy ∷ SProxy "testMount3") + testProcess = rootDir dir (SProxy ∷ SProxy "testMount3") file (SProxy ∷ SProxy "test") isNotFound ∷ ∀ a. Either QError a → Boolean isNotFound e = case e of diff --git a/test/src/Test/Unit/Main.purs b/test/src/Test/Unit/Main.purs index 10a7832..8350129 100644 --- a/test/src/Test/Unit/Main.purs +++ b/test/src/Test/Unit/Main.purs @@ -88,7 +88,7 @@ testURIParse ⇒ (URI.QAbsoluteURI → Either String a) → String → a - → Eff (assert :: ASSERT | eff) Unit + → Eff (assert ∷ ASSERT | eff) Unit testURIParse fromURI uri expected = case decode URI.qAbsoluteURI uri of Left err → fail $ "Test URI failed to parse as a URI even: \n\n\t" <> uri <> "\n\n\t" <> show err <> "\n\n" @@ -99,5 +99,5 @@ testURIParse fromURI uri expected = | config == expected → pure unit | otherwise → fail $ "Test URI failed to parse as expected config: \n\n\t" <> uri <> "\n\n\tExpected: " <> show expected <> "\n\n\tActual: " <> show config <> "\n\n" -fail ∷ ∀ eff. String → Eff (assert :: ASSERT | eff) Unit +fail ∷ ∀ eff. String → Eff (assert ∷ ASSERT | eff) Unit fail = flip assert' false diff --git a/test/src/Util/Effect.purs b/test/src/Util/Effect.purs index 957b6fa..603a0e4 100644 --- a/test/src/Util/Effect.purs +++ b/test/src/Util/Effect.purs @@ -14,14 +14,13 @@ import Node.Process (PROCESS) import Test.Assert (ASSERT) type Effects = - ( avar :: AVAR - , cp :: CHILD_PROCESS - , process :: PROCESS - , exception :: EXCEPTION - , fs :: FS - , buffer :: BUFFER - , console :: CONSOLE - , ajax :: AJAX - , assert :: ASSERT + ( avar ∷ AVAR + , cp ∷ CHILD_PROCESS + , process ∷ PROCESS + , exception ∷ EXCEPTION + , fs ∷ FS + , buffer ∷ BUFFER + , console ∷ CONSOLE + , ajax ∷ AJAX + , assert ∷ ASSERT ) - From 6015a722fbefe854895a1d8016b1cc6f178ed71c Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Thu, 1 Mar 2018 14:34:17 +0000 Subject: [PATCH 18/33] Fix Gen for more NES usage in URI --- src/Quasar/Mount/Common/Gen.purs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index f8a90b9..acccead 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -80,5 +80,5 @@ genThese ma mb = filtered do genCredentials ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.UserPassInfo genCredentials = URI.UserPassInfo <$> ({ user: _, password: _ } - <$> genAlphaNumericString - <*> Gen.choose (pure Nothing) (Just <$> genAlphaNumericString)) + <$> genAlphaNumericNEString + <*> Gen.choose (pure Nothing) (Just <$> genAlphaNumericNEString)) From 74f0d803a791702d2f85f8d0f2f3279b806b0003 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Thu, 1 Mar 2018 19:53:46 +0400 Subject: [PATCH 19/33] add QURI --- src/Quasar/URI.purs | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/src/Quasar/URI.purs b/src/Quasar/URI.purs index b1b8d45..311b2ed 100644 --- a/src/Quasar/URI.purs +++ b/src/Quasar/URI.purs @@ -23,6 +23,8 @@ module Quasar.URI , qRelativeRef , QURIRef , qURIRef + , QURI + , qURI , QHierarchicalPart , QURIHost , QURIHosts @@ -75,9 +77,10 @@ import URI.Path.Segment (PathSegment, PathSegmentNZ, segmentFromString, unsafeSe import URI.RelativeRef (print, parser, RelPath) as RelativeRef import URI.RelativeRef (RelativeRefOptions) as URI import URI.Scheme (Scheme) as URI -import URI.URI (URIOptions) as URI import URI.URIRef (print, parser) as URIRef import URI.URIRef (URIRefOptions) as URI +import URI.URI (print, parser) as URI' +import URI.URI (URIOptions) as URI type AbsPath = Py.AbsPath type AnyPath = Either Py.AbsPath Py.RelPath @@ -101,8 +104,8 @@ type QRelativeRefOptions = URI.RelativeRefOptions URI.UserPassInfo QURIHost AbsP type QURIRef = URI.URIRef URI.UserPassInfo QURIHost AbsPath AbsPath AnyPath QQuery URI.Fragment type QURIRefOptions = URI.URIRefOptions URI.UserPassInfo QURIHost AbsPath AbsPath AnyPath QQuery URI.Fragment --- type QURI = URI.URI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment --- type QURIOptions = URI.URIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment +type QURI = URI.URI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment +type QURIOptions = URI.URIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment qAbsoluteURI ∷ BasicCodec (Either ParseError) String QAbsoluteURI qAbsoluteURI = basicCodec @@ -124,17 +127,24 @@ qURIRef = basicCodec (flip runParser $ URIRef.parser opts.uriRef) (URIRef.print opts.uriRef) +qURI ∷ BasicCodec (Either ParseError) String QURI +qURI = basicCodec + (flip runParser $ URI'.parser opts.uri) + (URI'.print opts.uri) + opts ∷ { absoluteURI ∷ Record QAbsoluteURIOptions , mongoURI ∷ Record MongoURIOptions , relativeRef ∷ Record QRelativeRefOptions , uriRef ∷ Record QURIRefOptions + , uri ∷ Record QURIOptions } opts = { absoluteURI: _common `union` _Host `union` _Path `union` _HierPath , mongoURI: _common `union` _Hosts `union` _Path `union` _HierPath , relativeRef: _common `union` _Host `union` _Path`union` _Fragment `union` _RelPath , uriRef: _common `union` _Host `union` _HierPath `union` _Path `union` _Fragment `union` _RelPath + , uri: _common `union` _Host `union` _HierPath `union` _Path `union` _Fragment } where _common = _UserInfo `union` _Query From 8231e386b65315e4814274237bf9fa9768e695c2 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Fri, 2 Mar 2018 12:15:39 +0400 Subject: [PATCH 20/33] add QRelativePart --- src/Quasar/URI.purs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Quasar/URI.purs b/src/Quasar/URI.purs index 311b2ed..c19065a 100644 --- a/src/Quasar/URI.purs +++ b/src/Quasar/URI.purs @@ -26,6 +26,7 @@ module Quasar.URI , QURI , qURI , QHierarchicalPart + , QRelativePart , QURIHost , QURIHosts , QQuery @@ -90,7 +91,9 @@ type QURIHosts = URI.MultiHostPortPair URI.Host URI.Port type QAuthority = URI.Authority URI.UserPassInfo QURIHost type QQuery = URI.QueryPairs String String + type QHierarchicalPart = URI.HierarchicalPart URI.UserPassInfo QURIHost AbsPath AbsPath +type QRelativePart = URI.RelativePart URI.UserPassInfo QURIHost AbsPath AnyPath type QAbsoluteURI = URI.AbsoluteURI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery type QAbsoluteURIOptions = URI.AbsoluteURIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery From 6bae08a353524ef589d85c03f8a4bef696c24d02 Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Fri, 2 Mar 2018 17:21:55 +0000 Subject: [PATCH 21/33] Update for path-abempty change --- src/Quasar/URI.purs | 49 +++++++++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 22 deletions(-) diff --git a/src/Quasar/URI.purs b/src/Quasar/URI.purs index c19065a..285c07d 100644 --- a/src/Quasar/URI.purs +++ b/src/Quasar/URI.purs @@ -92,23 +92,23 @@ type QURIHosts = URI.MultiHostPortPair URI.Host URI.Port type QAuthority = URI.Authority URI.UserPassInfo QURIHost type QQuery = URI.QueryPairs String String -type QHierarchicalPart = URI.HierarchicalPart URI.UserPassInfo QURIHost AbsPath AbsPath -type QRelativePart = URI.RelativePart URI.UserPassInfo QURIHost AbsPath AnyPath +type QHierarchicalPart = URI.HierarchicalPart URI.UserPassInfo QURIHost (Maybe AbsPath) AbsPath +type QRelativePart = URI.RelativePart URI.UserPassInfo QURIHost (Maybe AbsPath) AnyPath -type QAbsoluteURI = URI.AbsoluteURI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery -type QAbsoluteURIOptions = URI.AbsoluteURIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery +type QAbsoluteURI = URI.AbsoluteURI URI.UserPassInfo QURIHost (Maybe AbsPath) AbsPath QQuery +type QAbsoluteURIOptions = URI.AbsoluteURIOptions URI.UserPassInfo QURIHost (Maybe AbsPath) AbsPath QQuery -type MongoURI = URI.AbsoluteURI URI.UserPassInfo QURIHosts AbsPath AbsPath QQuery -type MongoURIOptions = URI.AbsoluteURIOptions URI.UserPassInfo QURIHosts AbsPath AbsPath QQuery +type MongoURI = URI.AbsoluteURI URI.UserPassInfo QURIHosts (Maybe AbsPath) AbsPath QQuery +type MongoURIOptions = URI.AbsoluteURIOptions URI.UserPassInfo QURIHosts (Maybe AbsPath) AbsPath QQuery -type QRelativeRef = URI.RelativeRef URI.UserPassInfo QURIHost AbsPath AnyPath QQuery URI.Fragment -type QRelativeRefOptions = URI.RelativeRefOptions URI.UserPassInfo QURIHost AbsPath AnyPath QQuery URI.Fragment +type QRelativeRef = URI.RelativeRef URI.UserPassInfo QURIHost (Maybe AbsPath) AnyPath QQuery URI.Fragment +type QRelativeRefOptions = URI.RelativeRefOptions URI.UserPassInfo QURIHost (Maybe AbsPath) AnyPath QQuery URI.Fragment -type QURIRef = URI.URIRef URI.UserPassInfo QURIHost AbsPath AbsPath AnyPath QQuery URI.Fragment -type QURIRefOptions = URI.URIRefOptions URI.UserPassInfo QURIHost AbsPath AbsPath AnyPath QQuery URI.Fragment +type QURIRef = URI.URIRef URI.UserPassInfo QURIHost (Maybe AbsPath) AbsPath AnyPath QQuery URI.Fragment +type QURIRefOptions = URI.URIRefOptions URI.UserPassInfo QURIHost (Maybe AbsPath) AbsPath AnyPath QQuery URI.Fragment -type QURI = URI.URI URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment -type QURIOptions = URI.URIOptions URI.UserPassInfo QURIHost AbsPath AbsPath QQuery URI.Fragment +type QURI = URI.URI URI.UserPassInfo QURIHost (Maybe AbsPath) AbsPath QQuery URI.Fragment +type QURIOptions = URI.URIOptions URI.UserPassInfo QURIHost (Maybe AbsPath) AbsPath QQuery URI.Fragment qAbsoluteURI ∷ BasicCodec (Either ParseError) String QAbsoluteURI qAbsoluteURI = basicCodec @@ -181,16 +181,21 @@ opts = printHosts ∷ QURIHosts → String printHosts = MultiHostPortPair.print id id - parsePath ∷ Path → Either URIPartParseError AbsPath - parsePath = _parseAbsPath <<< Path.print - printPath ∷ AbsPath → Path - printPath = bimap viewAbsDir viewAbsFile >>>case _ of - Left d → - URI.Path - $ (fromFoldable d <#> runName >>> segmentFromString) <> [ segmentFromString "" ] - Right (Tuple d n) → - URI.Path - $ (fromFoldable d <#> asSegment) <> [asSegment n] + parsePath ∷ Path → Either URIPartParseError (Maybe AbsPath) + parsePath = case _ of + URI.Path [] → pure Nothing + p → Just <$> _parseAbsPath (Path.print p) + printPath ∷ Maybe AbsPath → Path + printPath = case _ of + Nothing → URI.Path [] + Just absP → + case bimap viewAbsDir viewAbsFile absP of + Left d → + URI.Path + $ (fromFoldable d <#> runName >>> segmentFromString) <> [ segmentFromString "" ] + Right (Tuple d n) → + URI.Path + $ (fromFoldable d <#> asSegment) <> [asSegment n] parseHierPath ∷ Either PathAbsolute PathRootless → Either URIPartParseError AbsPath From c3ff0cd89e4bd63e7aa2e4f74d3fb4fcf60e249b Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Fri, 9 Mar 2018 19:15:39 +0400 Subject: [PATCH 22/33] update printQPath type --- src/Quasar/Types.purs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Quasar/Types.purs b/src/Quasar/Types.purs index 09e3db7..786aa31 100644 --- a/src/Quasar/Types.purs +++ b/src/Quasar/Types.purs @@ -24,9 +24,9 @@ import Data.Either (Either, note) import Data.Maybe (Maybe) import Data.StrMap (StrMap) import Data.Traversable (traverse) -import Pathy (class IsDirOrFile, Abs, AbsDir, AbsFile, Path, parseAbsDir, parseAbsFile, posixParser, posixPrinter, printPath, sandboxAny) +import Pathy (class IsDirOrFile, class IsRelOrAbs, Abs, AbsDir, AbsFile, Path, parseAbsDir, parseAbsFile, posixParser, posixPrinter, printPath, sandboxAny) -printQPath ∷ ∀ b. IsDirOrFile b ⇒ Path Abs b → String +printQPath ∷ ∀ a b. IsRelOrAbs a ⇒ IsDirOrFile b ⇒ Path a b → String printQPath = sandboxAny >>> printPath posixPrinter parseQFilePath ∷ String → Maybe AbsFile From 0e41b0c4e797a953b17f5a3e4ea42bb354515d21 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Fri, 9 Mar 2018 20:22:31 +0400 Subject: [PATCH 23/33] =?UTF-8?q?printGroupPath=20=E2=88=B7=20GroupPath=20?= =?UTF-8?q?=E2=86=92=20NonEmptyString?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Quasar/Advanced/Types.purs | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/src/Quasar/Advanced/Types.purs b/src/Quasar/Advanced/Types.purs index 6439e35..4b4033c 100644 --- a/src/Quasar/Advanced/Types.purs +++ b/src/Quasar/Advanced/Types.purs @@ -9,10 +9,12 @@ import Data.Either (Either(..), note) import Data.Maybe (Maybe(..), fromMaybe, isJust) import Data.Newtype as Newtype import Data.String as Str -import Data.String.NonEmpty (NonEmptyString, fromString, toString) +import Data.String.NonEmpty (NonEmptyString) +import Data.String.NonEmpty as NES import Data.Traversable (traverse) import OIDC.Crypt.JSONWebKey (JSONWebKey) import OIDC.Crypt.Types (Issuer(..), ClientId(..)) +import Partial.Unsafe (unsafePartial) import Pathy (AbsDir, AbsFile, rootDir) import Quasar.Types (parseQDirPath, parseQFilePath, printQPath) @@ -22,15 +24,17 @@ derive instance eqGroupPath ∷ Eq GroupPath derive instance ordGroupPath ∷ Ord GroupPath derive instance newtypeGroupPath ∷ Newtype.Newtype GroupPath _ -printGroupPath ∷ GroupPath → String +printGroupPath ∷ GroupPath → NonEmptyString printGroupPath gp = let dir = Newtype.un GroupPath gp in - -- TODO(Christoph): Get rid of this once quasar treats Groups as directories + + unsafePartial $ NES.unsafeFromString + -- TODO(Christoph): Get rid of this once quasar treats Groups as directories if dir == rootDir - then printQPath dir - else fromMaybe "/" (Str.stripSuffix (Str.Pattern "/") (printQPath dir)) + then printQPath dir + else fromMaybe "/" (Str.stripSuffix (Str.Pattern "/") (printQPath dir)) parseGroupPath ∷ String → Either String GroupPath -- TODO(Christoph): Clean this up once Quasar treats Groups as directories @@ -94,7 +98,7 @@ derive instance ordQResource ∷ Ord QResource instance encodeJsonQResource ∷ EncodeJson QResource where encodeJson (File pt) = encodeJson $ "data:" <> printQPath pt encodeJson (Dir pt) = encodeJson $ "data:" <> printQPath pt - encodeJson (Group gpt) = encodeJson $ "group:" <> printGroupPath gpt + encodeJson (Group gpt) = encodeJson $ "group:" <> NES.toString (printGroupPath gpt) instance decodeJsonQResource ∷ DecodeJson QResource where decodeJson js = do @@ -167,12 +171,12 @@ instance decodeJsonUserId ∷ DecodeJson UserId where decodeJson = map UserId <<< decodeNEString encodeNEString ∷ NonEmptyString → Json -encodeNEString = encodeJson <<< toString +encodeNEString = encodeJson <<< NES.toString decodeNEString ∷ Json → Either String NonEmptyString decodeNEString j = do str ← decodeJson j - case fromString str of + case NES.fromString str of Nothing → Left "Expected string to be non empty" Just a → pure a @@ -214,7 +218,7 @@ derive instance ordGrantedTo ∷ Ord GrantedTo instance encodeJsonGrantedTo ∷ EncodeJson GrantedTo where encodeJson (UserGranted uid) = encodeJson uid - encodeJson (GroupGranted gpt) = encodeJson $ printGroupPath gpt + encodeJson (GroupGranted gpt) = encodeJson $ NES.toString (printGroupPath gpt) encodeJson (TokenGranted tk) = encodeJson tk instance decodeJsonGrantedTo ∷ DecodeJson GrantedTo where @@ -237,7 +241,7 @@ instance decodeJsonGrantedTo ∷ DecodeJson GrantedTo where parseUserId ∷ String → Either String UserId parseUserId str = Str.stripPrefix (Str.Pattern "user:") str - >>= fromString + >>= NES.fromString # map UserId # note "Could not parse user" @@ -245,7 +249,7 @@ instance decodeJsonGrantedTo ∷ DecodeJson GrantedTo where parseTokenId ∷ String → Either String TokenId parseTokenId str = Str.stripPrefix (Str.Pattern "token:") str - >>= fromString + >>= NES.fromString # map TokenId # note "Could not parse token" @@ -331,9 +335,9 @@ data ShareableSubject instance encodeJsonShareableSubject ∷ EncodeJson ShareableSubject where encodeJson (UserSubject (UserId uid)) = - encodeJson $ "user:" <> toString uid + encodeJson $ "user:" <> NES.toString uid encodeJson (GroupSubject gpt) = - encodeJson $ printGroupPath gpt + encodeJson $ NES.toString (printGroupPath gpt) type ShareRequestR = @@ -349,8 +353,8 @@ runShareRequest (ShareRequest r) = r instance encodeJsonShareRequest ∷ EncodeJson ShareRequest where encodeJson (ShareRequest obj) = - "subjects" := ((map (append "user:" <<< toString <<< runUserId) obj.users) - <> map (append "group:" <<< printGroupPath) obj.groups) + "subjects" := ((map (append "user:" <<< NES.toString <<< runUserId) obj.users) + <> map (append "group:" <<< NES.toString <<< printGroupPath) obj.groups) ~> "actions" := (map Action $ obj.actions) ~> jsonEmptyObject From 07a8fa44f6cfcf922adc61bc59d4ca23077eae2b Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 13 Mar 2018 22:17:07 +0100 Subject: [PATCH 24/33] fix build --- src/Quasar/Types.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Quasar/Types.purs b/src/Quasar/Types.purs index 786aa31..5e844af 100644 --- a/src/Quasar/Types.purs +++ b/src/Quasar/Types.purs @@ -24,7 +24,7 @@ import Data.Either (Either, note) import Data.Maybe (Maybe) import Data.StrMap (StrMap) import Data.Traversable (traverse) -import Pathy (class IsDirOrFile, class IsRelOrAbs, Abs, AbsDir, AbsFile, Path, parseAbsDir, parseAbsFile, posixParser, posixPrinter, printPath, sandboxAny) +import Pathy (class IsDirOrFile, class IsRelOrAbs, AbsDir, AbsFile, Path, parseAbsDir, parseAbsFile, posixParser, posixPrinter, printPath, sandboxAny) printQPath ∷ ∀ a b. IsRelOrAbs a ⇒ IsDirOrFile b ⇒ Path a b → String printQPath = sandboxAny >>> printPath posixPrinter From 818acbc2fb5d79674a57017556b983bebf974dc7 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 13 Mar 2018 22:24:18 +0100 Subject: [PATCH 25/33] remove `/` from current and parent dir segments --- src/Quasar/URI.purs | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/src/Quasar/URI.purs b/src/Quasar/URI.purs index 285c07d..8d50fad 100644 --- a/src/Quasar/URI.purs +++ b/src/Quasar/URI.purs @@ -192,7 +192,7 @@ opts = case bimap viewAbsDir viewAbsFile absP of Left d → URI.Path - $ (fromFoldable d <#> runName >>> segmentFromString) <> [ segmentFromString "" ] + $ (fromFoldable d <#> runName >>> segmentFromString) <> [ forceTrailingSlash ] Right (Tuple d n) → URI.Path $ (fromFoldable d <#> asSegment) <> [asSegment n] @@ -220,7 +220,7 @@ opts = Left Nil → PathAbsolute.PathAbsolute Nothing Left (Cons head tail) → PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ head) - $ (asSegment <$> fromFoldable tail) <> [ segmentFromString "" ] + $ (asSegment <$> fromFoldable tail) <> [ forceTrailingSlash ] Right (Tuple d n) → case d of Nil → PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ n) [] Cons head tail → PathAbsolute.PathAbsolute @@ -234,21 +234,26 @@ opts = Left (Cons head tail) → PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ maybe parentDirSegment (un Name) head) - $ (segmentFromString <<< maybe "../" runName <$> fromFoldable tail) <> [ segmentFromString "" ] + $ (segmentFromString <<< maybe ".." runName <$> fromFoldable tail) <> [ forceTrailingSlash ] Right (Tuple d n) → case d of Nil → PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ un Name n) [] Cons head tail → PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ maybe parentDirSegment (un Name) head) - $ (segmentFromString <<< maybe "../" runName <$> fromFoldable tail) <> [ asSegment n ] - - + $ (segmentFromString <<< maybe ".." runName <$> fromFoldable tail) <> [ asSegment n ] + + + -- Array of segments is joined using "/" so to have trailing slash in rendered + -- string for dir pathes, we need to use this empty segment. + forceTrailingSlash ∷ PathSegment + forceTrailingSlash = segmentFromString "" + currentDirSegment ∷ NonEmptyString - currentDirSegment = case NES.fromString "./" of + currentDirSegment = case NES.fromString "." of Nothing → unsafeCrashWith "unreachable case in currentDirSegment" Just a → a parentDirSegment ∷ NonEmptyString - parentDirSegment = case NES.fromString "../" of + parentDirSegment = case NES.fromString ".." of Nothing → unsafeCrashWith "unreachable case in parentDirSegment" Just a → a _parseAbsPath ∷ String → Either URIPartParseError Py.AbsPath From ffd9668e69115fb086540bb0203cbdc6c1373576 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Wed, 14 Mar 2018 15:43:56 +0100 Subject: [PATCH 26/33] add QURIHost' a non empty version of QURIHost --- src/Quasar/URI.purs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Quasar/URI.purs b/src/Quasar/URI.purs index 8d50fad..e3cb869 100644 --- a/src/Quasar/URI.purs +++ b/src/Quasar/URI.purs @@ -27,6 +27,7 @@ module Quasar.URI , qURI , QHierarchicalPart , QRelativePart + , QURIHost' , QURIHost , QURIHosts , QQuery @@ -50,6 +51,7 @@ import Data.Newtype (un) import Data.Record.Builder as Builder import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES +import Data.These (These) import Data.Tuple (Tuple(..)) import Partial.Unsafe (unsafeCrashWith) import Pathy (Name(..), foldPath, posixParser) @@ -86,6 +88,7 @@ import URI.URI (URIOptions) as URI type AbsPath = Py.AbsPath type AnyPath = Either Py.AbsPath Py.RelPath +type QURIHost' = These URI.Host URI.Port type QURIHost = URI.HostPortPair URI.Host URI.Port type QURIHosts = URI.MultiHostPortPair URI.Host URI.Port From 29ce6f8f26d63c997cbe3dc16943df38c8bbe582 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Wed, 14 Mar 2018 15:59:00 +0100 Subject: [PATCH 27/33] add QURIHost' and use it instead of QURIHost --- src/Quasar/Mount/Common/Gen.purs | 7 +++++-- src/Quasar/Mount/Couchbase.purs | 11 +++++------ src/Quasar/Mount/Couchbase/Gen.purs | 4 ++-- src/Quasar/Mount/MarkLogic.purs | 8 +++++--- src/Quasar/Mount/MarkLogic/Gen.purs | 4 ++-- src/Quasar/Mount/SparkHDFS.purs | 17 ++++++++++------- src/Quasar/Mount/SparkHDFS/Gen.purs | 6 +++--- src/Quasar/URI.purs | 6 ++++-- 8 files changed, 36 insertions(+), 27 deletions(-) diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index acccead..5662434 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -61,11 +61,14 @@ genHostURI = Gen.oneOf $ genIPv4 :| [genName] genPort ∷ ∀ m. MonadRec m ⇒ MonadGen m ⇒ m URI.Port genPort = filtered $ Port.fromInt <$> Gen.chooseInt 50000 65535 +genHost' ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.QURIHost' +genHost' = genThese genHostURI genPort + genHost ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.QURIHost -genHost = genMaybe $ genThese genHostURI genPort +genHost = genMaybe genHost' genHosts ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.QURIHosts -genHosts = Gen.unfoldable $ genThese genHostURI genPort +genHosts = Gen.unfoldable genHost' genThese ∷ ∀ m a b. MonadGen m ⇒ MonadRec m ⇒ m a → m b → m (These a b) genThese ma mb = filtered do diff --git a/src/Quasar/Mount/Couchbase.purs b/src/Quasar/Mount/Couchbase.purs index dd1f7b5..537b22f 100644 --- a/src/Quasar/Mount/Couchbase.purs +++ b/src/Quasar/Mount/Couchbase.purs @@ -41,7 +41,7 @@ import Quasar.URI as URI import URI.Scheme as Scheme type Config = - { host ∷ URI.QURIHost + { host ∷ URI.QURIHost' , bucketName ∷ Maybe NonEmptyString , password ∷ String , docTypeKey ∷ String @@ -71,15 +71,12 @@ toURI { host, bucketName, password, docTypeKey, queryTimeout } = hierarchicalPart ∷ URI.QHierarchicalPart hierarchicalPart = URI.HierarchicalPartAuth - authority + (URI.Authority Nothing (Just host)) (case bucketName of Nothing → Just $ Left P.rootDir Just n → Just $ Right $ P.rootDir P.file' (Name n) ) - authority ∷ URI.QAuthority - authority = URI.Authority Nothing host - props ∷ Array (Tuple String (Maybe String)) props = [ Tuple "password" (Just password) @@ -89,7 +86,9 @@ toURI { host, bucketName, password, docTypeKey, queryTimeout } = fromURI ∷ URI.QAbsoluteURI → Either String Config fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartNoAuth path) query) = Left "Expected 'auth' part in URI" -fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ host) path) query) = do +fromURI (URI.AbsoluteURI _ (URI.HierarchicalPartAuth (URI.Authority _ Nothing) _) _) = do + Left "Expected 'host' part to be present in URL" +fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ (Just host)) path) query) = do unless (scheme == uriScheme) $ Left "Expected 'couchbase' URL scheme" bucketName ← case path of Nothing → Left "Path is missing from URL" diff --git a/src/Quasar/Mount/Couchbase/Gen.purs b/src/Quasar/Mount/Couchbase/Gen.purs index 02ca978..d635a40 100644 --- a/src/Quasar/Mount/Couchbase/Gen.purs +++ b/src/Quasar/Mount/Couchbase/Gen.purs @@ -24,13 +24,13 @@ import Control.Monad.Gen.Common as GenC import Control.Monad.Rec.Class (class MonadRec) import Data.Maybe (Maybe(..)) import Data.Time.Duration.Gen (genSeconds) -import Quasar.Mount.Common.Gen (genAlphaNumericNEString, genAlphaNumericString, genHost) +import Quasar.Mount.Common.Gen (genAlphaNumericNEString, genAlphaNumericString, genHost') import Quasar.Mount.Couchbase as CB genConfig ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m CB.Config genConfig = { host: _, bucketName: _, password: _, docTypeKey: _, queryTimeout: _ } - <$> genHost + <$> genHost' <*> Gen.choose (pure Nothing) (Just <$> genAlphaNumericNEString) <*> genAlphaNumericString <*> genAlphaNumericString diff --git a/src/Quasar/Mount/MarkLogic.purs b/src/Quasar/Mount/MarkLogic.purs index 6552fff..625f6d6 100644 --- a/src/Quasar/Mount/MarkLogic.purs +++ b/src/Quasar/Mount/MarkLogic.purs @@ -37,7 +37,7 @@ import Quasar.URI as URI import URI.Scheme as Scheme type Config = - { host ∷ URI.QURIHost + { host ∷ URI.QURIHost' , path ∷ Maybe AbsPath , credentials ∷ Maybe URI.UserPassInfo , format ∷ Format @@ -72,7 +72,7 @@ toURI ∷ Config → URI.QAbsoluteURI toURI { host, path, credentials, format } = URI.AbsoluteURI uriScheme - (URI.HierarchicalPartAuth (URI.Authority credentials host) path) + (URI.HierarchicalPartAuth (URI.Authority credentials (Just host)) path) (Just (URI.QueryPairs [ (Tuple "format" (Just formatStr)) ])) where formatStr ∷ String @@ -83,7 +83,9 @@ toURI { host, path, credentials, format } = fromURI ∷ URI.QAbsoluteURI → Either String Config fromURI (URI.AbsoluteURI _ (URI.HierarchicalPartNoAuth _) _) = do Left "Expected 'auth' part in URI" -fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority credentials host) path) query) = do +fromURI (URI.AbsoluteURI _ (URI.HierarchicalPartAuth (URI.Authority _ Nothing) _) _) = do + Left "Expected 'host' part to be present in URL" +fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority credentials (Just host)) path) query) = do unless (scheme == uriScheme) $ Left "Expected 'xcc' URL scheme" let props = maybe SM.empty (\(URI.QueryPairs qs) → SM.fromFoldable qs) query diff --git a/src/Quasar/Mount/MarkLogic/Gen.purs b/src/Quasar/Mount/MarkLogic/Gen.purs index 67c2572..1d43380 100644 --- a/src/Quasar/Mount/MarkLogic/Gen.purs +++ b/src/Quasar/Mount/MarkLogic/Gen.purs @@ -23,7 +23,7 @@ import Control.Monad.Gen as Gen import Control.Monad.Gen.Common as GenC import Control.Monad.Rec.Class (class MonadRec) import Pathy.Gen (genAbsAnyPath) -import Quasar.Mount.Common.Gen (genCredentials, genHost) +import Quasar.Mount.Common.Gen (genCredentials, genHost') import Quasar.Mount.MarkLogic as ML genFormat ∷ ∀ m. MonadGen m ⇒ m ML.Format @@ -32,7 +32,7 @@ genFormat = Gen.choose (pure ML.JSON) (pure ML.XML) genConfig ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m ML.Config genConfig = { host: _, path: _, credentials: _, format: _ } - <$> genHost + <$> genHost' <*> GenC.genMaybe genAbsAnyPath <*> GenC.genMaybe genCredentials <*> genFormat diff --git a/src/Quasar/Mount/SparkHDFS.purs b/src/Quasar/Mount/SparkHDFS.purs index 44bf68f..cf5c474 100644 --- a/src/Quasar/Mount/SparkHDFS.purs +++ b/src/Quasar/Mount/SparkHDFS.purs @@ -39,8 +39,8 @@ import Quasar.URI as URI import URI.Scheme as Scheme type Config = - { sparkHost ∷ URI.QURIHost - , hdfsHost ∷ URI.QURIHost + { sparkHost ∷ URI.QURIHost' + , hdfsHost ∷ URI.QURIHost' , path ∷ AbsDir , props ∷ SM.StrMap (Maybe String) } @@ -74,7 +74,9 @@ toURI cfg = fromURI ∷ URI.QAbsoluteURI → Either String Config fromURI (URI.AbsoluteURI _ (URI.HierarchicalPartNoAuth _) _) = do Left "Expected 'auth' part in URI" -fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ sparkHost) _) query) = do +fromURI (URI.AbsoluteURI _ (URI.HierarchicalPartAuth (URI.Authority _ Nothing) _) _) = do + Left "Expected 'host' part to be present in URL" +fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ (Just sparkHost)) _) query) = do unless (scheme == sparkURIScheme) $ Left "Expected `spark` URL scheme" let props = maybe SM.empty (\(URI.QueryPairs qs) → SM.fromFoldable qs) query @@ -92,20 +94,21 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ spark pure { sparkHost, hdfsHost, path, props: props'' } -mkURI ∷ URI.Scheme → URI.QURIHost → Maybe URI.QQuery → URI.QAbsoluteURI +mkURI ∷ URI.Scheme → URI.QURIHost' → Maybe URI.QQuery → URI.QAbsoluteURI mkURI scheme host params = URI.AbsoluteURI (scheme) - (URI.HierarchicalPartAuth (URI.Authority Nothing host) Nothing) + (URI.HierarchicalPartAuth (URI.Authority Nothing (Just host)) Nothing) params -extractHost' ∷ URI.Scheme → String → Either String URI.QURIHost +extractHost' ∷ URI.Scheme → String → Either String URI.QURIHost' extractHost' scheme uri = do URI.AbsoluteURI scheme' hierPart _ ← lmap show $ decode URI.qAbsoluteURI uri unless (scheme' == scheme) $ Left $ "Expected '" <> Scheme.print scheme <> "' URL scheme" case hierPart of URI.HierarchicalPartNoAuth _ → Left $ "Expected auth part to be present in URL" - URI.HierarchicalPartAuth (URI.Authority _ host) _ → pure host + URI.HierarchicalPartAuth (URI.Authority _ Nothing) _ → Left "Expected 'host' part to be present in URL" + URI.HierarchicalPartAuth (URI.Authority _ (Just host)) _ → pure host sparkURIScheme ∷ URI.Scheme sparkURIScheme = Scheme.unsafeFromString "spark" diff --git a/src/Quasar/Mount/SparkHDFS/Gen.purs b/src/Quasar/Mount/SparkHDFS/Gen.purs index df59d06..7d6271a 100644 --- a/src/Quasar/Mount/SparkHDFS/Gen.purs +++ b/src/Quasar/Mount/SparkHDFS/Gen.purs @@ -22,13 +22,13 @@ import Control.Monad.Gen (class MonadGen) import Control.Monad.Gen.Common as GenC import Control.Monad.Rec.Class (class MonadRec) import Data.StrMap.Gen as SMG -import Quasar.Mount.Common.Gen (genAlphaNumericString, genHost, genAbsDirPath) +import Quasar.Mount.Common.Gen (genAlphaNumericString, genHost', genAbsDirPath) import Quasar.Mount.SparkHDFS as SHDFS genConfig ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m SHDFS.Config genConfig = { sparkHost: _, hdfsHost: _, path: _, props: _ } - <$> genHost - <*> genHost + <$> genHost' + <*> genHost' <*> genAbsDirPath <*> SMG.genStrMap genAlphaNumericString (GenC.genMaybe genAlphaNumericString) diff --git a/src/Quasar/URI.purs b/src/Quasar/URI.purs index e3cb869..0281747 100644 --- a/src/Quasar/URI.purs +++ b/src/Quasar/URI.purs @@ -89,8 +89,10 @@ type AbsPath = Py.AbsPath type AnyPath = Either Py.AbsPath Py.RelPath type QURIHost' = These URI.Host URI.Port -type QURIHost = URI.HostPortPair URI.Host URI.Port -type QURIHosts = URI.MultiHostPortPair URI.Host URI.Port +-- NOTE: this is same as `URI.HostPortPair URI.Host URI.Port` +type QURIHost = Maybe QURIHost' +-- NOTE: this is same as `URI.MultiHostPortPair URI.Host URI.Port` +type QURIHosts = Array QURIHost' type QAuthority = URI.Authority URI.UserPassInfo QURIHost type QQuery = URI.QueryPairs String String From 9aeba5a8f80ef40c69d2286bf6cd3f7267eac3e0 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Wed, 14 Mar 2018 16:36:37 +0100 Subject: [PATCH 28/33] `Maybe NonEmptyString` to `String` --- src/Quasar/Mount/Couchbase.purs | 10 +++++----- src/Quasar/Mount/Couchbase/Gen.purs | 6 ++---- test/src/Test/Unit/Main.purs | 5 ++--- 3 files changed, 9 insertions(+), 12 deletions(-) diff --git a/src/Quasar/Mount/Couchbase.purs b/src/Quasar/Mount/Couchbase.purs index 537b22f..01f21d6 100644 --- a/src/Quasar/Mount/Couchbase.purs +++ b/src/Quasar/Mount/Couchbase.purs @@ -31,8 +31,8 @@ import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.Newtype (un) import Data.Number as Num -import Data.String.NonEmpty (NonEmptyString) import Data.StrMap as SM +import Data.String.NonEmpty as NES import Data.Time.Duration (Seconds(..)) import Data.Tuple (Tuple(..)) import Pathy (Name(..), ()) @@ -42,7 +42,7 @@ import URI.Scheme as Scheme type Config = { host ∷ URI.QURIHost' - , bucketName ∷ Maybe NonEmptyString + , bucketName ∷ String , password ∷ String , docTypeKey ∷ String , queryTimeout ∷ Maybe Seconds @@ -72,7 +72,7 @@ toURI { host, bucketName, password, docTypeKey, queryTimeout } = hierarchicalPart = URI.HierarchicalPartAuth (URI.Authority Nothing (Just host)) - (case bucketName of + (case NES.fromString bucketName of Nothing → Just $ Left P.rootDir Just n → Just $ Right $ P.rootDir P.file' (Name n) ) @@ -93,9 +93,9 @@ fromURI (URI.AbsoluteURI scheme (URI.HierarchicalPartAuth (URI.Authority _ (Just bucketName ← case path of Nothing → Left "Path is missing from URL" Just (Left p) - | p == P.rootDir → pure Nothing + | p == P.rootDir → pure "" | otherwise → Left "Expected a file path" - Just (Right p) → pure $ Just $ un P.Name $ P.fileName p + Just (Right p) → pure $ NES.toString $ un P.Name $ P.fileName p let props = maybe SM.empty (\(URI.QueryPairs qs) → SM.fromFoldable qs) query pure { host diff --git a/src/Quasar/Mount/Couchbase/Gen.purs b/src/Quasar/Mount/Couchbase/Gen.purs index d635a40..458057d 100644 --- a/src/Quasar/Mount/Couchbase/Gen.purs +++ b/src/Quasar/Mount/Couchbase/Gen.purs @@ -19,19 +19,17 @@ module Quasar.Mount.Couchbase.Gen where import Prelude import Control.Monad.Gen (class MonadGen) -import Control.Monad.Gen as Gen import Control.Monad.Gen.Common as GenC import Control.Monad.Rec.Class (class MonadRec) -import Data.Maybe (Maybe(..)) import Data.Time.Duration.Gen (genSeconds) -import Quasar.Mount.Common.Gen (genAlphaNumericNEString, genAlphaNumericString, genHost') +import Quasar.Mount.Common.Gen (genAlphaNumericString, genHost') import Quasar.Mount.Couchbase as CB genConfig ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m CB.Config genConfig = { host: _, bucketName: _, password: _, docTypeKey: _, queryTimeout: _ } <$> genHost' - <*> Gen.choose (pure Nothing) (Just <$> genAlphaNumericNEString) + <*> genAlphaNumericString <*> genAlphaNumericString <*> genAlphaNumericString <*> GenC.genMaybe genSeconds diff --git a/test/src/Test/Unit/Main.purs b/test/src/Test/Unit/Main.purs index 8350129..688292c 100644 --- a/test/src/Test/Unit/Main.purs +++ b/test/src/Test/Unit/Main.purs @@ -25,7 +25,6 @@ import Data.Codec (decode, encode) import Data.Either (Either(..)) import Data.Maybe (Maybe(..)) import Data.Monoid (mempty) -import Data.String.NonEmpty (fromString) import Data.String.NonEmpty as NES import Data.These (These(..)) import Data.Time.Duration (Seconds(..)) @@ -56,7 +55,7 @@ main = do "couchbase://localhost/testBucket?password=&docTypeKey=" (CBT.TestConfig { host: Just $ This (URI.NameAddress $ RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost") - , bucketName: fromString "testBucket" + , bucketName: "testBucket" , password: "" , docTypeKey: "" , queryTimeout: Nothing @@ -66,7 +65,7 @@ main = do "couchbase://localhost:9999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (CBT.TestConfig { host: Just $ Both (URI.NameAddress $ RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost") (Port.unsafeFromInt 9999) - , bucketName: fromString "testBucket" + , bucketName: "testBucket" , password: "pass" , docTypeKey: "type" , queryTimeout: Just (Seconds (20.0)) From cb44e1c036c3bab02859d440ca1562bdae1b593c Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Wed, 14 Mar 2018 17:32:07 +0100 Subject: [PATCH 29/33] export {parse,print}* functions used in *options --- src/Quasar/URI.purs | 243 ++++++++++++++++++++++++-------------------- 1 file changed, 131 insertions(+), 112 deletions(-) diff --git a/src/Quasar/URI.purs b/src/Quasar/URI.purs index 0281747..3f6e897 100644 --- a/src/Quasar/URI.purs +++ b/src/Quasar/URI.purs @@ -34,6 +34,22 @@ module Quasar.URI , AbsPath , AnyPath , QAuthority + , parseQuery + , printQuery + , parseUserInfo + , printUserInfo + , parseHost + , printHost + , parseHosts + , printHosts + , parsePath + , printPath + , parseHierPath + , printHierPath + , parseFragment + , printFragment + , printRelPath + , parseRelPath , opts , module URI ) where @@ -166,120 +182,123 @@ opts = _Fragment = { parseFragment, printFragment } _RelPath = { parseRelPath, printRelPath } - parseQuery ∷ URI.Query → Either URIPartParseError QQuery - parseQuery = QueryPairs.parse (QueryPairs.keyToString >>> pure) (QueryPairs.valueToString >>> pure) - printQuery ∷ QQuery → URI.Query - printQuery = QueryPairs.print QueryPairs.keyFromString QueryPairs.valueFromString - - parseUserInfo ∷ URI.UserInfo → Either URIPartParseError URI.UserPassInfo - parseUserInfo = UserPassInfo.parse - printUserInfo ∷ URI.UserPassInfo → URI.UserInfo - printUserInfo = UserPassInfo.print - - parseHost ∷ Parser String QURIHost - parseHost = HostPortPair.parser pure pure - printHost ∷ QURIHost → String - printHost = HostPortPair.print id id - - parseHosts ∷ Parser String QURIHosts - parseHosts = MultiHostPortPair.parser pure pure - printHosts ∷ QURIHosts → String - printHosts = MultiHostPortPair.print id id - - parsePath ∷ Path → Either URIPartParseError (Maybe AbsPath) - parsePath = case _ of - URI.Path [] → pure Nothing - p → Just <$> _parseAbsPath (Path.print p) - printPath ∷ Maybe AbsPath → Path - printPath = case _ of - Nothing → URI.Path [] - Just absP → - case bimap viewAbsDir viewAbsFile absP of - Left d → - URI.Path - $ (fromFoldable d <#> runName >>> segmentFromString) <> [ forceTrailingSlash ] - Right (Tuple d n) → - URI.Path - $ (fromFoldable d <#> asSegment) <> [asSegment n] - - - parseHierPath ∷ Either PathAbsolute PathRootless → Either URIPartParseError AbsPath - parseHierPath = _parseAbsPath <<< either PathAbsolute.print PathRootless.print - printHierPath ∷ AbsPath → Either PathAbsolute PathRootless - printHierPath = _printAbsPath >>> Left - - parseFragment ∷ URI.Fragment → Either URIPartParseError URI.Fragment - parseFragment = Right - printFragment ∷ URI.Fragment → URI.Fragment - printFragment = id - - printRelPath ∷ AnyPath → RelativeRef.RelPath - printRelPath = bimap _printAbsPath _printRelPath - parseRelPath ∷ RelativeRef.RelPath → Either URIPartParseError AnyPath - parseRelPath = bitraverse - (PathAbsolute.print >>> _parseAbsPath) - (PathNoScheme.print >>> _parseRelPath) - - _printAbsPath ∷ Py.AbsPath → PathAbsolute - _printAbsPath = bimap viewAbsDir viewAbsFile >>> case _ of - Left Nil → PathAbsolute.PathAbsolute Nothing - Left (Cons head tail) → PathAbsolute.PathAbsolute $ Just +parseQuery ∷ URI.Query → Either URIPartParseError QQuery +parseQuery = QueryPairs.parse (QueryPairs.keyToString >>> pure) (QueryPairs.valueToString >>> pure) +printQuery ∷ QQuery → URI.Query +printQuery = QueryPairs.print QueryPairs.keyFromString QueryPairs.valueFromString + +parseUserInfo ∷ URI.UserInfo → Either URIPartParseError URI.UserPassInfo +parseUserInfo = UserPassInfo.parse +printUserInfo ∷ URI.UserPassInfo → URI.UserInfo +printUserInfo = UserPassInfo.print + +parseHost ∷ Parser String QURIHost +parseHost = HostPortPair.parser pure pure +printHost ∷ QURIHost → String +printHost = HostPortPair.print id id + +parseHosts ∷ Parser String QURIHosts +parseHosts = MultiHostPortPair.parser pure pure +printHosts ∷ QURIHosts → String +printHosts = MultiHostPortPair.print id id + +parsePath ∷ Path → Either URIPartParseError (Maybe AbsPath) +parsePath = case _ of + URI.Path [] → pure Nothing + p → Just <$> _parseAbsPath (Path.print p) +printPath ∷ Maybe AbsPath → Path +printPath = case _ of + Nothing → URI.Path [] + Just absP → + case bimap viewAbsDir viewAbsFile absP of + Left d → + URI.Path + $ (fromFoldable d <#> runName >>> segmentFromString) <> [ forceTrailingSlash ] + Right (Tuple d n) → + URI.Path + $ (fromFoldable d <#> asSegment) <> [asSegment n] + +parseHierPath ∷ Either PathAbsolute PathRootless → Either URIPartParseError AbsPath +parseHierPath = _parseAbsPath <<< either PathAbsolute.print PathRootless.print +printHierPath ∷ AbsPath → Either PathAbsolute PathRootless +printHierPath = _printAbsPath >>> Left + +parseFragment ∷ URI.Fragment → Either URIPartParseError URI.Fragment +parseFragment = Right +printFragment ∷ URI.Fragment → URI.Fragment +printFragment = id + +printRelPath ∷ AnyPath → RelativeRef.RelPath +printRelPath = bimap _printAbsPath _printRelPath +parseRelPath ∷ RelativeRef.RelPath → Either URIPartParseError AnyPath +parseRelPath = bitraverse + (PathAbsolute.print >>> _parseAbsPath) + (PathNoScheme.print >>> _parseRelPath) + +-- ===== INTERNAL ===== + +_printAbsPath ∷ Py.AbsPath → PathAbsolute +_printAbsPath = bimap viewAbsDir viewAbsFile >>> case _ of + Left Nil → PathAbsolute.PathAbsolute Nothing + Left (Cons head tail) → PathAbsolute.PathAbsolute $ Just + $ Tuple (asSegmentNZ head) + $ (asSegment <$> fromFoldable tail) <> [ forceTrailingSlash ] + Right (Tuple d n) → case d of + Nil → PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ n) [] + Cons head tail → PathAbsolute.PathAbsolute + $ Just $ Tuple (asSegmentNZ head) - $ (asSegment <$> fromFoldable tail) <> [ forceTrailingSlash ] - Right (Tuple d n) → case d of - Nil → PathAbsolute.PathAbsolute $ Just $ Tuple (asSegmentNZ n) [] - Cons head tail → PathAbsolute.PathAbsolute - $ Just - $ Tuple (asSegmentNZ head) - $ (asSegment <$> fromFoldable tail) <> [ asSegment n ] - - _printRelPath ∷ Py.RelPath → PathNoScheme.PathNoScheme - _printRelPath = bimap viewRelDir viewRelFile >>> case _ of - Left Nil → PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString currentDirSegment) [] - Left (Cons head tail) → - PathNoScheme.PathNoScheme - $ Tuple (unsafeSegmentNZNCFromString $ maybe parentDirSegment (un Name) head) - $ (segmentFromString <<< maybe ".." runName <$> fromFoldable tail) <> [ forceTrailingSlash ] - - Right (Tuple d n) → case d of - Nil → PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ un Name n) [] - Cons head tail → PathNoScheme.PathNoScheme - $ Tuple (unsafeSegmentNZNCFromString $ maybe parentDirSegment (un Name) head) - $ (segmentFromString <<< maybe ".." runName <$> fromFoldable tail) <> [ asSegment n ] - + $ (asSegment <$> fromFoldable tail) <> [ asSegment n ] + +_printRelPath ∷ Py.RelPath → PathNoScheme.PathNoScheme +_printRelPath = bimap viewRelDir viewRelFile >>> case _ of + Left Nil → PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString currentDirSegment) [] + Left (Cons head tail) → + PathNoScheme.PathNoScheme + $ Tuple (unsafeSegmentNZNCFromString $ maybe parentDirSegment (un Name) head) + $ (segmentFromString <<< maybe ".." runName <$> fromFoldable tail) <> [ forceTrailingSlash ] + + Right (Tuple d n) → case d of + Nil → PathNoScheme.PathNoScheme $ Tuple (unsafeSegmentNZNCFromString $ un Name n) [] + Cons head tail → PathNoScheme.PathNoScheme + $ Tuple (unsafeSegmentNZNCFromString $ maybe parentDirSegment (un Name) head) + $ (segmentFromString <<< maybe ".." runName <$> fromFoldable tail) <> [ asSegment n ] + + +-- Array of segments is joined using "/" so to have trailing slash in rendered +-- string for dir pathes, we need to use this empty segment. +forceTrailingSlash ∷ PathSegment +forceTrailingSlash = segmentFromString "" - -- Array of segments is joined using "/" so to have trailing slash in rendered - -- string for dir pathes, we need to use this empty segment. - forceTrailingSlash ∷ PathSegment - forceTrailingSlash = segmentFromString "" - - currentDirSegment ∷ NonEmptyString - currentDirSegment = case NES.fromString "." of - Nothing → unsafeCrashWith "unreachable case in currentDirSegment" - Just a → a - parentDirSegment ∷ NonEmptyString - parentDirSegment = case NES.fromString ".." of - Nothing → unsafeCrashWith "unreachable case in parentDirSegment" - Just a → a - _parseAbsPath ∷ String → Either URIPartParseError Py.AbsPath - _parseAbsPath = - Py.parsePath posixParser - (const Nothing) - (Just <<< Left) - (const Nothing) - (Just <<< Right) - Nothing - >>> note (URIPartParseError "Could not parse valid absolute path") - - _parseRelPath ∷ String → Either URIPartParseError Py.RelPath - _parseRelPath = - Py.parsePath posixParser - (Just <<< Left) - (const Nothing) - (Just <<< Right) - (const Nothing) - Nothing - >>> note (URIPartParseError "Could not parse valid relative path") +currentDirSegment ∷ NonEmptyString +currentDirSegment = case NES.fromString "." of + Nothing → unsafeCrashWith "unreachable case in currentDirSegment" + Just a → a + +parentDirSegment ∷ NonEmptyString +parentDirSegment = case NES.fromString ".." of + Nothing → unsafeCrashWith "unreachable case in parentDirSegment" + Just a → a + +_parseAbsPath ∷ String → Either URIPartParseError Py.AbsPath +_parseAbsPath = + Py.parsePath posixParser + (const Nothing) + (Just <<< Left) + (const Nothing) + (Just <<< Right) + Nothing + >>> note (URIPartParseError "Could not parse valid absolute path") + +_parseRelPath ∷ String → Either URIPartParseError Py.RelPath +_parseRelPath = + Py.parsePath posixParser + (Just <<< Left) + (const Nothing) + (Just <<< Right) + (const Nothing) + Nothing + >>> note (URIPartParseError "Could not parse valid relative path") -- Union which rejects duplicates union From 9f8196cd68d86731488378a6b23dd62b4130918a Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Thu, 15 Mar 2018 14:48:31 +0100 Subject: [PATCH 30/33] fix test; review changes --- src/Quasar/Mount/Common/Gen.purs | 17 +++-------------- src/Quasar/Mount/Couchbase.purs | 7 +++---- test/src/Test/Unit/Main.purs | 4 ++-- 3 files changed, 8 insertions(+), 20 deletions(-) diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index 5662434..a20107c 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -30,39 +30,28 @@ import Data.Char.Gen as CG import Data.Maybe (Maybe(..)) import Data.NonEmpty ((:|)) import Data.String.Gen as SG -import Data.String.NonEmpty (NonEmptyString, cons) +import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES import Data.These (These(..)) import Pathy.Gen (genAbsDirPath, genAbsFilePath) as PGen import Quasar.URI as URI import URI.Host.Gen as HostGen -import URI.Host.RegName as RegName import URI.Port as Port genAlphaNumericString ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m String genAlphaNumericString = SG.genString genAlphaNumericChar genAlphaNumericNEString ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m NonEmptyString -genAlphaNumericNEString = cons <$> genAlphaNumericChar <*> SG.genString genAlphaNumericChar +genAlphaNumericNEString = NES.cons <$> genAlphaNumericChar <*> SG.genString genAlphaNumericChar genAlphaNumericChar ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m Char genAlphaNumericChar = Gen.oneOf $ CG.genDigitChar :| [CG.genAlpha] -genHostURI ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.Host -genHostURI = Gen.oneOf $ genIPv4 :| [genName] - where - genIPv4 = URI.IPv4Address <$> HostGen.genIPv4 - genName = URI.NameAddress <$> genRegName - genRegName = do - head ← CG.genAlpha - tail ← genAlphaNumericString - pure $ RegName.fromString $ NES.cons head tail - genPort ∷ ∀ m. MonadRec m ⇒ MonadGen m ⇒ m URI.Port genPort = filtered $ Port.fromInt <$> Gen.chooseInt 50000 65535 genHost' ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.QURIHost' -genHost' = genThese genHostURI genPort +genHost' = genThese HostGen.genHost genPort genHost ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.QURIHost genHost = genMaybe genHost' diff --git a/src/Quasar/Mount/Couchbase.purs b/src/Quasar/Mount/Couchbase.purs index 01f21d6..6780cf1 100644 --- a/src/Quasar/Mount/Couchbase.purs +++ b/src/Quasar/Mount/Couchbase.purs @@ -66,16 +66,15 @@ toURI { host, bucketName, password, docTypeKey, queryTimeout } = URI.AbsoluteURI uriScheme hierarchicalPart - (Just (URI.QueryPairs props)) + (Just $ URI.QueryPairs props) where hierarchicalPart ∷ URI.QHierarchicalPart hierarchicalPart = URI.HierarchicalPartAuth - (URI.Authority Nothing (Just host)) - (case NES.fromString bucketName of + (URI.Authority Nothing $ Just host) + case NES.fromString bucketName of Nothing → Just $ Left P.rootDir Just n → Just $ Right $ P.rootDir P.file' (Name n) - ) props ∷ Array (Tuple String (Maybe String)) props = diff --git a/test/src/Test/Unit/Main.purs b/test/src/Test/Unit/Main.purs index 688292c..20b6831 100644 --- a/test/src/Test/Unit/Main.purs +++ b/test/src/Test/Unit/Main.purs @@ -54,7 +54,7 @@ main = do testURIParse (map CBT.TestConfig <$> CB.fromURI) "couchbase://localhost/testBucket?password=&docTypeKey=" (CBT.TestConfig - { host: Just $ This (URI.NameAddress $ RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost") + { host: This (URI.NameAddress $ RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost") , bucketName: "testBucket" , password: "" , docTypeKey: "" @@ -64,7 +64,7 @@ main = do testURIParse (map CBT.TestConfig <$> CB.fromURI) "couchbase://localhost:9999/testBucket?password=pass&docTypeKey=type&queryTimeoutSeconds=20" (CBT.TestConfig - { host: Just $ Both (URI.NameAddress $ RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost") (Port.unsafeFromInt 9999) + { host: Both (URI.NameAddress $ RegName.unsafeFromString $ unsafePartial $ NES.unsafeFromString "localhost") (Port.unsafeFromInt 9999) , bucketName: "testBucket" , password: "pass" , docTypeKey: "type" From 5c99c8d5591b5171ebce5239842c0ebdb74492a0 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Thu, 15 Mar 2018 18:09:21 +0100 Subject: [PATCH 31/33] use genThese from Data.These.Gen --- src/Quasar/Mount/Common/Gen.purs | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/src/Quasar/Mount/Common/Gen.purs b/src/Quasar/Mount/Common/Gen.purs index a20107c..61c3cc6 100644 --- a/src/Quasar/Mount/Common/Gen.purs +++ b/src/Quasar/Mount/Common/Gen.purs @@ -24,7 +24,6 @@ import Prelude import Control.Monad.Gen (class MonadGen, filtered) import Control.Monad.Gen as Gen import Control.Monad.Gen.Common (genMaybe) -import Control.Monad.Gen.Common as GenC import Control.Monad.Rec.Class (class MonadRec) import Data.Char.Gen as CG import Data.Maybe (Maybe(..)) @@ -32,7 +31,7 @@ import Data.NonEmpty ((:|)) import Data.String.Gen as SG import Data.String.NonEmpty (NonEmptyString) import Data.String.NonEmpty as NES -import Data.These (These(..)) +import Data.These.Gen (genThese) import Pathy.Gen (genAbsDirPath, genAbsFilePath) as PGen import Quasar.URI as URI import URI.Host.Gen as HostGen @@ -59,16 +58,6 @@ genHost = genMaybe genHost' genHosts ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.QURIHosts genHosts = Gen.unfoldable genHost' -genThese ∷ ∀ m a b. MonadGen m ⇒ MonadRec m ⇒ m a → m b → m (These a b) -genThese ma mb = filtered do - a' ← GenC.genMaybe ma - b' ← GenC.genMaybe mb - pure case a', b' of - Just a, Just b → Just $ Both a b - Just a, Nothing → Just $ This a - Nothing, Just b → Just $ That b - Nothing, Nothing → Nothing - genCredentials ∷ ∀ m. MonadGen m ⇒ MonadRec m ⇒ m URI.UserPassInfo genCredentials = URI.UserPassInfo <$> ({ user: _, password: _ } From d2e8b93794ba5089e74ad0e683a30c9d51ecca5c Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Mon, 19 Mar 2018 18:14:14 +0100 Subject: [PATCH 32/33] rename printGroupPath to runGroupPath add printGroupPath and printUserId --- src/Quasar/Advanced/Types.purs | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/src/Quasar/Advanced/Types.purs b/src/Quasar/Advanced/Types.purs index 4b4033c..9f38ca3 100644 --- a/src/Quasar/Advanced/Types.purs +++ b/src/Quasar/Advanced/Types.purs @@ -24,8 +24,11 @@ derive instance eqGroupPath ∷ Eq GroupPath derive instance ordGroupPath ∷ Ord GroupPath derive instance newtypeGroupPath ∷ Newtype.Newtype GroupPath _ -printGroupPath ∷ GroupPath → NonEmptyString -printGroupPath gp = +printGroupPath ∷ GroupPath → String +printGroupPath = NES.toString <<< runGroupPath + +runGroupPath ∷ GroupPath → NonEmptyString +runGroupPath gp = let dir = Newtype.un GroupPath gp in @@ -98,7 +101,7 @@ derive instance ordQResource ∷ Ord QResource instance encodeJsonQResource ∷ EncodeJson QResource where encodeJson (File pt) = encodeJson $ "data:" <> printQPath pt encodeJson (Dir pt) = encodeJson $ "data:" <> printQPath pt - encodeJson (Group gpt) = encodeJson $ "group:" <> NES.toString (printGroupPath gpt) + encodeJson (Group gpt) = encodeJson $ "group:" <> printGroupPath gpt instance decodeJsonQResource ∷ DecodeJson QResource where decodeJson js = do @@ -161,6 +164,9 @@ newtype UserId = UserId NonEmptyString runUserId ∷ UserId → NonEmptyString runUserId (UserId s) = s +printUserId ∷ UserId → String +printUserId = NES.toString <<< runUserId + derive instance eqUserId ∷ Eq UserId derive instance ordUserId ∷ Ord UserId @@ -218,7 +224,7 @@ derive instance ordGrantedTo ∷ Ord GrantedTo instance encodeJsonGrantedTo ∷ EncodeJson GrantedTo where encodeJson (UserGranted uid) = encodeJson uid - encodeJson (GroupGranted gpt) = encodeJson $ NES.toString (printGroupPath gpt) + encodeJson (GroupGranted gpt) = encodeJson $ printGroupPath gpt encodeJson (TokenGranted tk) = encodeJson tk instance decodeJsonGrantedTo ∷ DecodeJson GrantedTo where @@ -337,7 +343,7 @@ instance encodeJsonShareableSubject ∷ EncodeJson ShareableSubject where encodeJson (UserSubject (UserId uid)) = encodeJson $ "user:" <> NES.toString uid encodeJson (GroupSubject gpt) = - encodeJson $ NES.toString (printGroupPath gpt) + encodeJson $ printGroupPath gpt type ShareRequestR = @@ -353,8 +359,8 @@ runShareRequest (ShareRequest r) = r instance encodeJsonShareRequest ∷ EncodeJson ShareRequest where encodeJson (ShareRequest obj) = - "subjects" := ((map (append "user:" <<< NES.toString <<< runUserId) obj.users) - <> map (append "group:" <<< NES.toString <<< printGroupPath) obj.groups) + "subjects" := ((map (append "user:" <<< printUserId) obj.users) + <> map (append "group:" <<< printGroupPath) obj.groups) ~> "actions" := (map Action $ obj.actions) ~> jsonEmptyObject From 2033964f2f908c78660badb4ba6ea5faee9e5394 Mon Sep 17 00:00:00 2001 From: Irakli Safareli Date: Tue, 20 Mar 2018 22:05:56 +0100 Subject: [PATCH 33/33] upse published version deps --- bower.json | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/bower.json b/bower.json index a48fe5a..33ff15a 100644 --- a/bower.json +++ b/bower.json @@ -25,11 +25,11 @@ "purescript-nonempty": "^4.1.1", "purescript-numbers": "^5.0.0", "purescript-oidc-crypt-utils": "^7.0.1", - "purescript-pathy": "safareli/purescript-pathy#refactor", + "purescript-pathy": "^5.0.0", "purescript-string-parsers": "^3.0.0", "purescript-strings": "^3.5.0", - "purescript-uri": "garyb/purescript-uri#next", - "purescript-sql-squared": "safareli/purescript-sql-squared#pathy", + "purescript-uri": "^5.0.0", + "purescript-sql-squared": "^0.11.0", "purescript-const": "^3.2.0", "purescript-codec": "^2.1.0" },