Skip to content
This repository was archived by the owner on Jul 19, 2022. It is now read-only.

FQN: Add support for special characters #199

Merged
merged 1 commit into from
Aug 17, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
111 changes: 97 additions & 14 deletions src/FullyQualifiedName.elm
Original file line number Diff line number Diff line change
Expand Up @@ -6,11 +6,15 @@ module FullyQualifiedName exposing
, fromList
, fromParent
, fromString
, fromUrlList
, fromUrlString
, isSuffixOf
, isValidSegmentChar
, isValidUrlSegmentChar
, namespaceOf
, segments
, toString
, toUrlSegments
, toUrlString
, unqualifiedName
, urlParser
Expand All @@ -19,6 +23,7 @@ module FullyQualifiedName exposing
import Json.Decode as Decode
import List.Nonempty as NEL
import String.Extra as StringE
import Url
import Url.Parser


Expand All @@ -31,28 +36,39 @@ type FQN


{-| Turn a string, like "base.List.map" into FQN ["base", "List", "map"]
Split text into segments. A smarter version of `Text.split` that handles
the name `.` properly.
-}
fromString : String -> FQN
fromString rawFqn =
let
go s =
case s of
[] ->
[]

"" :: "" :: z ->
"." :: go z

"" :: z ->
go z

x :: y ->
x :: go y
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Adapted from the Haskell implementation

in
rawFqn
|> String.split "."
|> go
|> fromList


fromList : List String -> FQN
fromList segments_ =
let
rootEmptyToDot i s =
if i == 0 && String.isEmpty s then
"."

else
s
in
segments_
|> List.map String.trim
|> List.indexedMap rootEmptyToDot
|> List.filter (\s -> String.length s > 0)
|> List.filter (String.isEmpty >> not)
|> NEL.fromList
|> Maybe.withDefault (NEL.fromElement ".")
|> FQN
Expand All @@ -61,8 +77,21 @@ fromList segments_ =
fromUrlString : String -> FQN
fromUrlString str =
str
|> String.replace "/" "."
|> fromString
|> String.split "/"
|> fromUrlList


fromUrlList : List String -> FQN
fromUrlList segments_ =
let
urlDecode s =
-- Let invalid % encoding fall through, since it then must be valid
-- strings
Maybe.withDefault s (Url.percentDecode s)
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

percentDecode seems a bit strange to me in that it fails if it encounters a % not followed by valid encoding characters. That kind of configuration are still valid URLs though.

in
segments_
|> List.map (urlDecode >> urlDecodeSegmentDot)
|> fromList


toString : FQN -> String
Expand All @@ -71,6 +100,7 @@ toString (FQN nameParts) =
-- Absolute FQNs start with a dot, so when also
-- joining parts using a dot, we get dot dot (..),
-- which we don't want.
-- TODO: this does mean that we don't support . as a term name on the root...
trimLeadingDot str =
if String.startsWith ".." str then
String.dropLeft 1 str
Expand All @@ -84,11 +114,19 @@ toString (FQN nameParts) =
|> trimLeadingDot


toUrlSegments : FQN -> NEL.Nonempty String
toUrlSegments fqn =
fqn
|> segments
|> NEL.map (Url.percentEncode >> urlEncodeSegmentDot)


toUrlString : FQN -> String
toUrlString fqn =
fqn
|> toString
|> String.replace "." "/"
|> toUrlSegments
|> NEL.toList
|> String.join "/"


segments : FQN -> NEL.Nonempty String
Expand Down Expand Up @@ -161,3 +199,48 @@ decodeFromParent parentFqn =
decode : Decode.Decoder FQN
decode =
Decode.map fromString Decode.string


isValidSegmentChar : Char -> Bool
isValidSegmentChar c =
let
validSymbols =
String.toList "!$%^&*-=+<>.~\\/:_'"
in
Char.isAlphaNum c || List.member c validSymbols


isValidUrlSegmentChar : Char -> Bool
isValidUrlSegmentChar c =
-- '/' is a segment separator in Urls and
-- should be escaped to %2F, so when
-- unescaped, its not a valid segment
-- character when parsing URLs.
c /= '/' && isValidSegmentChar c



-- INTERNAL HELPERS


{-| URLs can't include a single dot in a path segment like so "base/./docs",
but this is a valid definition name in Unison, the composition operator for
example is named "." To get around this we encode dots as ";." in segments such
that "base...doc" becomes "base/;./doc"
-}
urlEncodeSegmentDot : String -> String
urlEncodeSegmentDot s =
if s == "." then
";."

else
s


urlDecodeSegmentDot : String -> String
urlDecodeSegmentDot s =
if s == ";." then
"."

else
s
10 changes: 5 additions & 5 deletions src/HashQualified.elm
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,7 @@ fromString str =
str
|> Hash.fromString
|> Maybe.map HashOnly
|> MaybeE.orElse (hashQualifiedFromString Hash.prefix str)
|> MaybeE.orElse (hashQualifiedFromString FQN.fromString Hash.prefix str)
|> Maybe.withDefault (NameOnly (FQN.fromString str))


Expand All @@ -57,7 +57,7 @@ fromUrlString str =
str
|> Hash.fromUrlString
|> Maybe.map HashOnly
|> MaybeE.orElse (hashQualifiedFromString Hash.urlPrefix str)
|> MaybeE.orElse (hashQualifiedFromString FQN.fromUrlString Hash.urlPrefix str)
|> Maybe.withDefault (NameOnly (FQN.fromUrlString str))


Expand Down Expand Up @@ -142,8 +142,8 @@ isRawHashQualified str =
not (Hash.isRawHash str) && String.contains Hash.urlPrefix str


hashQualifiedFromString : String -> String -> Maybe HashQualified
hashQualifiedFromString sep str =
hashQualifiedFromString : (String -> FQN) -> String -> String -> Maybe HashQualified
hashQualifiedFromString toFQN sep str =
if isRawHashQualified str then
let
parts =
Expand All @@ -161,7 +161,7 @@ hashQualifiedFromString sep str =

name_ :: unprefixedHash :: [] ->
Hash.fromString (Hash.prefix ++ unprefixedHash)
|> Maybe.map (HashQualified (FQN.fromString name_))
|> Maybe.map (HashQualified (toFQN name_))
Copy link
Member Author

@hojberg hojberg Aug 16, 2021

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This was a bug; we were never passing this through a URL encoder.


_ ->
Nothing
Expand Down
4 changes: 2 additions & 2 deletions src/Route.elm
Original file line number Diff line number Diff line change
Expand Up @@ -152,13 +152,13 @@ toUrlString route =
hqToPath hq =
case hq of
NameOnly fqn ->
NEL.toList (FQN.segments fqn)
fqn |> FQN.toUrlSegments |> NEL.toList

HashOnly h ->
[ Hash.toUrlString h ]

HashQualified fqn h ->
String.split "/" (FQN.toUrlString fqn ++ Hash.toUrlString h)
NEL.toList (FQN.toUrlSegments fqn) ++ [ Hash.toUrlString h ]

perspectiveParamsToPath pp includeNamespacesSuffix =
case pp of
Expand Down
16 changes: 13 additions & 3 deletions src/Route/Parsers.elm
Original file line number Diff line number Diff line change
Expand Up @@ -26,11 +26,21 @@ fqn : Parser FQN
fqn =
let
segment =
Parser.oneOf
-- Special case ;. which is an escaped . (dot), since we also use
-- ';' as the separator character between namespace FQNs and
-- definition FQNs. (';' is not a valid character in FQNs and is
-- safe as a separator/escape character).
[ b (succeed (identity ".") |. s ";.")
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Having this special case here didn't feel great, but was the simplest when chomping deals with character to character which would lead to a clash with /;/ (the namespace/definition separator).

, b chompSegment
]

chompSegment =
Parser.getChompedString <|
Parser.succeed ()
|. Parser.chompWhile Char.isAlphaNum
|. Parser.chompWhile FQN.isValidUrlSegmentChar
in
Parser.map FQN.fromList
Parser.map FQN.fromUrlList
(Parser.sequence
{ start = ""
, separator = "/"
Expand All @@ -44,7 +54,7 @@ fqn =

fqnEnd : Parser ()
fqnEnd =
Parser.symbol "-"
Parser.symbol ";"


hash : Parser Hash
Expand Down
70 changes: 58 additions & 12 deletions tests/FullyQualifiedNameTests.elm
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ module FullyQualifiedNameTests exposing (..)

import Expect
import FullyQualifiedName as FQN exposing (..)
import List.Nonempty as NEL
import Test exposing (..)


Expand All @@ -10,17 +11,20 @@ fromString =
describe "FullyQualifiedName.fromString"
[ test "Creates an FQN from a string" <|
\_ ->
Expect.equal "a.b.c" (FQN.toString (FQN.fromString "a.b.c"))
Expect.equal [ "a", "b", "c" ] (segments (FQN.fromString "a.b.c"))
, test "Creates an FQN from a string where a segment includes a dot (like the composition operatory)" <|
\_ ->
Expect.equal [ "base", "." ] (segments (FQN.fromString "base.."))
, describe "Root"
[ test "Creates a root FQN from \"\"" <|
\_ ->
Expect.equal "." (FQN.toString (FQN.fromString ""))
Expect.equal [ "." ] (segments (FQN.fromString ""))
, test "Creates a root FQN from \" \"" <|
\_ ->
Expect.equal "." (FQN.toString (FQN.fromString " "))
Expect.equal [ "." ] (segments (FQN.fromString " "))
, test "Creates a root FQN from \".\"" <|
\_ ->
Expect.equal "." (FQN.toString (FQN.fromString "."))
Expect.equal [ "." ] (segments (FQN.fromString "."))
]
]

Expand All @@ -30,17 +34,44 @@ fromUrlString =
describe "FullyQualifiedName.fromUrlString"
[ test "Creates an FQN from a URL string (segments separate by /)" <|
\_ ->
Expect.equal "a.b.c" (FQN.toString (FQN.fromUrlString "a/b/c"))
Expect.equal [ "a", "b", "c" ] (segments (FQN.fromUrlString "a/b/c"))
, test "Supports . in segments (compose)" <|
\_ ->
Expect.equal [ "a", "b", "." ] (segments (FQN.fromUrlString "a/b/."))
, test "Supports special characters n segments" <|
\_ ->
let
results =
[ segments (FQN.fromUrlString "a/b/+")
, segments (FQN.fromUrlString "a/b/*")
, segments (FQN.fromUrlString "a/b/%2F") -- /
, segments (FQN.fromUrlString "a/b/%25") -- %
, segments (FQN.fromUrlString "a/b/!")
, segments (FQN.fromUrlString "a/b/-")
, segments (FQN.fromUrlString "a/b/==")
]

expects =
[ [ "a", "b", "+" ]
, [ "a", "b", "*" ]
, [ "a", "b", "/" ]
, [ "a", "b", "%" ]
, [ "a", "b", "!" ]
, [ "a", "b", "-" ]
, [ "a", "b", "==" ]
]
in
Expect.equal expects results
, describe "Root"
[ test "Creates a root FQN from \"\"" <|
\_ ->
Expect.equal "." (FQN.toString (FQN.fromUrlString ""))
Expect.equal [ "." ] (segments (FQN.fromUrlString ""))
, test "Creates a root FQN from \" \"" <|
\_ ->
Expect.equal "." (FQN.toString (FQN.fromUrlString " "))
Expect.equal [ "." ] (segments (FQN.fromUrlString " "))
, test "Creates a root FQN from \"/\"" <|
\_ ->
Expect.equal "." (FQN.toString (FQN.fromUrlString "/"))
Expect.equal [ "." ] (segments (FQN.fromUrlString "/"))
]
]

Expand All @@ -51,9 +82,9 @@ toString =
[ test "serializes the FQN" <|
\_ ->
Expect.equal "foo.bar" (FQN.toString (FQN.fromString "foo.bar"))
, test "includes root dot when an absolute fqn" <|
, test "it supports . as term names (compose)" <|
\_ ->
Expect.equal ".foo.bar" (FQN.toString (FQN.fromString ".foo.bar"))
Expect.equal "foo.bar.." (FQN.toString (FQN.fromString "foo.bar.."))
]


Expand All @@ -63,9 +94,15 @@ toUrlString =
[ test "serializes the FQN with segments separate by /" <|
\_ ->
Expect.equal "foo/bar" (FQN.toUrlString (FQN.fromString "foo.bar"))
, test "includes root dot when an absolute fqn" <|
, test "URL encodes / (divide) segments" <|
\_ ->
Expect.equal "foo/bar/%2F/doc" (FQN.toUrlString (FQN.fromString "foo.bar./.doc"))
, test "URL encodes % segments" <|
\_ ->
Expect.equal "/foo/bar" (FQN.toUrlString (FQN.fromString ".foo.bar"))
Expect.equal "foo/bar/%25/doc" (FQN.toUrlString (FQN.fromString "foo.bar.%.doc"))
, test "URL encodes . segments with a ; prefix" <|
\_ ->
Expect.equal "foo/bar/;./doc" (FQN.toUrlString (FQN.fromString "foo.bar...doc"))
]


Expand Down Expand Up @@ -157,3 +194,12 @@ namespaceOf =
in
Expect.equal (Just "base.Map") (FQN.namespaceOf suffix fqn)
]



-- HELPERS


segments : FQN -> List String
segments =
FQN.segments >> NEL.toList
Loading