Add support for quoted path components (#690)
... as standardized in https://github.com/dhall-lang/dhall-lang/pull/293
This commit is contained in:
parent
adf94a6503
commit
8bc595be7f
|
@ -322,6 +322,7 @@ Library
|
|||
text >= 0.11.1.0 && < 1.3 ,
|
||||
transformers >= 0.2.0.0 && < 0.6 ,
|
||||
unordered-containers >= 0.1.3.0 && < 0.3 ,
|
||||
uri-encode < 1.6 ,
|
||||
vector >= 0.11.0.0 && < 0.13
|
||||
if flag(with-http)
|
||||
Build-Depends:
|
||||
|
|
|
@ -57,6 +57,7 @@ module Dhall.Core (
|
|||
, reservedIdentifiers
|
||||
, escapeText
|
||||
, subExpressions
|
||||
, pathCharacter
|
||||
) where
|
||||
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
|
@ -75,7 +76,7 @@ import Data.String (IsString(..))
|
|||
import Data.Semigroup (Semigroup(..))
|
||||
import Data.Sequence (Seq, ViewL(..), ViewR(..))
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Prettyprint.Doc (Pretty)
|
||||
import Data.Text.Prettyprint.Doc (Doc, Pretty)
|
||||
import Data.Traversable
|
||||
import Dhall.Map (Map)
|
||||
import Dhall.Set (Set)
|
||||
|
@ -131,10 +132,7 @@ instance Semigroup Directory where
|
|||
Directory (components₁ <> components₀)
|
||||
|
||||
instance Pretty Directory where
|
||||
pretty (Directory {..}) =
|
||||
foldMap prettyComponent (reverse components)
|
||||
where
|
||||
prettyComponent text = "/" <> Pretty.pretty text
|
||||
pretty (Directory {..}) = foldMap prettyPathComponent (reverse components)
|
||||
|
||||
{-| A `File` is a `directory` followed by one additional path component
|
||||
representing the `file` name
|
||||
|
@ -145,7 +143,9 @@ data File = File
|
|||
} deriving (Eq, Generic, Ord, Show)
|
||||
|
||||
instance Pretty File where
|
||||
pretty (File {..}) = Pretty.pretty directory <> "/" <> Pretty.pretty file
|
||||
pretty (File {..}) =
|
||||
Pretty.pretty directory
|
||||
<> prettyPathComponent file
|
||||
|
||||
instance Semigroup File where
|
||||
File directory₀ _ <> File directory₁ file =
|
||||
|
@ -2331,3 +2331,28 @@ subExpressions f (Project a b) = Project <$> f a <*> pure b
|
|||
subExpressions f (Note a b) = Note a <$> f b
|
||||
subExpressions f (ImportAlt l r) = ImportAlt <$> f l <*> f r
|
||||
subExpressions _ (Embed a) = pure (Embed a)
|
||||
|
||||
{-| Returns `True` if the given `Char` is valid within an unquoted path
|
||||
component
|
||||
|
||||
This is exported for reuse within the @"Dhall.Parser.Token"@ module
|
||||
-}
|
||||
pathCharacter :: Char -> Bool
|
||||
pathCharacter c =
|
||||
'\x21' == c
|
||||
|| ('\x24' <= c && c <= '\x27')
|
||||
|| ('\x2A' <= c && c <= '\x2B')
|
||||
|| ('\x2D' <= c && c <= '\x2E')
|
||||
|| ('\x30' <= c && c <= '\x3B')
|
||||
|| c == '\x3D'
|
||||
|| ('\x40' <= c && c <= '\x5A')
|
||||
|| ('\x5E' <= c && c <= '\x7A')
|
||||
|| c == '\x7C'
|
||||
|| c == '\x7E'
|
||||
|
||||
prettyPathComponent :: Text -> Doc ann
|
||||
prettyPathComponent text
|
||||
| Data.Text.all pathCharacter text =
|
||||
"/" <> Pretty.pretty text
|
||||
| otherwise =
|
||||
"/\"" <> Pretty.pretty text <> "\""
|
||||
|
|
|
@ -189,6 +189,7 @@ import qualified Dhall.Map
|
|||
import qualified Dhall.Parser
|
||||
import qualified Dhall.Pretty.Internal
|
||||
import qualified Dhall.TypeCheck
|
||||
import qualified Network.URI.Encode
|
||||
import qualified System.Environment
|
||||
import qualified System.Directory as Directory
|
||||
import qualified System.FilePath as FilePath
|
||||
|
@ -610,13 +611,22 @@ exprFromUncachedImport (Import {..}) = do
|
|||
|
||||
return (path, text)
|
||||
|
||||
Remote (URL scheme authority file query fragment maybeHeaders) -> do
|
||||
Remote (URL scheme authority path query fragment maybeHeaders) -> do
|
||||
let prefix =
|
||||
(case scheme of HTTP -> "http"; HTTPS -> "https")
|
||||
<> "://"
|
||||
<> authority
|
||||
|
||||
let fileText = Dhall.Pretty.Internal.prettyToStrictText file
|
||||
let File {..} = path
|
||||
let Directory {..} = directory
|
||||
|
||||
let pathComponentToText component =
|
||||
"/" <> Network.URI.Encode.encodeText component
|
||||
|
||||
let fileText =
|
||||
Text.concat
|
||||
(map pathComponentToText (reverse components))
|
||||
<> pathComponentToText file
|
||||
|
||||
let suffix =
|
||||
(case query of Nothing -> ""; Just q -> "?" <> q)
|
||||
|
|
|
@ -109,6 +109,7 @@ import qualified Data.HashSet
|
|||
import qualified Data.List.NonEmpty
|
||||
import qualified Data.Text
|
||||
import qualified Dhall.Set
|
||||
import qualified Text.Megaparsec
|
||||
import qualified Text.Parser.Char
|
||||
import qualified Text.Parser.Combinators
|
||||
|
||||
|
@ -325,25 +326,25 @@ posixEnvironmentVariableCharacter =
|
|||
|| ('\x3E' <= c && c <= '\x5B')
|
||||
|| ('\x5D' <= c && c <= '\x7E')
|
||||
|
||||
pathCharacter :: Char -> Bool
|
||||
pathCharacter c =
|
||||
('\x21' <= c && c <= '\x22')
|
||||
|| ('\x24' <= c && c <= '\x27')
|
||||
|| ('\x2A' <= c && c <= '\x2B')
|
||||
|| ('\x2D' <= c && c <= '\x2E')
|
||||
|| ('\x30' <= c && c <= '\x3B')
|
||||
|| c == '\x3D'
|
||||
|| ('\x40' <= c && c <= '\x5A')
|
||||
|| ('\x5E' <= c && c <= '\x7A')
|
||||
|| c == '\x7C'
|
||||
|| c == '\x7E'
|
||||
quotedPathCharacter :: Char -> Bool
|
||||
quotedPathCharacter c =
|
||||
('\x20' <= c && c <= '\x21')
|
||||
|| ('\x23' <= c && c <= '\x2E')
|
||||
|| ('\x30' <= c && c <= '\x7E')
|
||||
|
||||
pathComponent :: Parser Text
|
||||
pathComponent = do
|
||||
_ <- "/" :: Parser Text
|
||||
string <- some (Text.Parser.Char.satisfy pathCharacter)
|
||||
|
||||
return (Data.Text.pack string)
|
||||
let pathData = Text.Megaparsec.takeWhile1P Nothing Dhall.Core.pathCharacter
|
||||
|
||||
let quotedPathData = do
|
||||
_ <- Text.Parser.Char.char '"'
|
||||
text <- Text.Megaparsec.takeWhile1P Nothing quotedPathCharacter
|
||||
_ <- Text.Parser.Char.char '"'
|
||||
return text
|
||||
|
||||
pathData <|> quotedPathData
|
||||
|
||||
file_ :: Parser File
|
||||
file_ = do
|
||||
|
|
|
@ -149,6 +149,9 @@ parserTests =
|
|||
, shouldParse
|
||||
"Sort"
|
||||
"./tests/parser/success/sort"
|
||||
, shouldParse
|
||||
"quoted path components"
|
||||
"./tests/parser/success/quotedPaths"
|
||||
, shouldNotParse
|
||||
"positive double out of bounds"
|
||||
"./tests/parser/failure/doubleBoundsPos.dhall"
|
||||
|
|
3
dhall/tests/parser/success/quotedPathsA.dhall
Normal file
3
dhall/tests/parser/success/quotedPathsA.dhall
Normal file
|
@ -0,0 +1,3 @@
|
|||
{ example0 = /"foo"/bar/"baz qux"
|
||||
, example1 = https://example.com/foo/"bar?baz"?qux
|
||||
}
|
24
dhall/tests/parser/success/quotedPathsB.dhall
Normal file
24
dhall/tests/parser/success/quotedPathsB.dhall
Normal file
|
@ -0,0 +1,24 @@
|
|||
[
|
||||
"3.0.0",
|
||||
[
|
||||
8,
|
||||
{
|
||||
"example0": [
|
||||
24,
|
||||
2,
|
||||
"foo",
|
||||
"bar",
|
||||
"baz qux"
|
||||
],
|
||||
"example1": [
|
||||
24,
|
||||
1,
|
||||
"example.com",
|
||||
"foo",
|
||||
"bar?baz",
|
||||
"qux",
|
||||
null
|
||||
]
|
||||
}
|
||||
]
|
||||
]
|
Loading…
Reference in New Issue
Block a user