Merge pull request #199 from unisonweb/support-special-character-fqns

FQN: Add support for special characters

Author: hojberg

src/FullyQualifiedName.elm

@@ -6,11 +6,15 @@ module FullyQualifiedName exposing
     , fromList
     , fromParent
     , fromString
+    , fromUrlList
     , fromUrlString
     , isSuffixOf
+    , isValidSegmentChar
+    , isValidUrlSegmentChar
     , namespaceOf
     , segments
     , toString
+    , toUrlSegments
     , toUrlString
     , unqualifiedName
     , urlParser
@@ -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
 
 
@@ -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
+    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
@@ -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)
+    in
+    segments_
+        |> List.map (urlDecode >> urlDecodeSegmentDot)
+        |> fromList
 
 
 toString : FQN -> String
@@ -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
@@ -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
@@ -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

src/HashQualified.elm

@@ -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))
 
 
@@ -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))
 
 
@@ -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 =
@@ -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_))
 
             _ ->
                 Nothing

src/Route.elm

@@ -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

src/Route/Parsers.elm

@@ -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 ";.")
+                , 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 = "/"
@@ -44,7 +54,7 @@ fqn =
 
 fqnEnd : Parser ()
 fqnEnd =
-    Parser.symbol "-"
+    Parser.symbol ";"
 
 
 hash : Parser Hash

tests/FullyQualifiedNameTests.elm

@@ -2,6 +2,7 @@ module FullyQualifiedNameTests exposing (..)
 
 import Expect
 import FullyQualifiedName as FQN exposing (..)
+import List.Nonempty as NEL
 import Test exposing (..)
 
 
@@ -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 "."))
             ]
         ]
 
@@ -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 "/"))
             ]
         ]
 
@@ -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.."))
         ]
 
 
@@ -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"))
         ]
 
 
@@ -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