Show ambiguous types fully qualified

frontend/Component/Documentation.elm

@@ -17,15 +17,29 @@ type alias DocDict =
     Dict.Dict String (Text.Text, Maybe (String, Int), String)
 
 
-toDocDict : List String -> Documentation -> DocDict
-toDocDict modules docs =
+toDocDict : List String -> List (String, String) -> Documentation -> DocDict
+toDocDict modules mentionedTypes docs =
   let toPairs view getAssocPrec entries =
           List.map (\entry -> (entry.name, (view entry, getAssocPrec entry, entry.comment))) entries
+
+      ambiguousTypes =
+          dropUniques (List.sort (List.map snd mentionedTypes))
   in
       Dict.fromList <|
-        toPairs (viewAlias modules) (always Nothing) docs.aliases
-        ++ toPairs (viewUnion modules) (always Nothing) docs.unions
-        ++ toPairs (viewValue modules) .assocPrec docs.values
+        toPairs (viewAlias modules ambiguousTypes) (always Nothing) docs.aliases
+        ++ toPairs (viewUnion modules ambiguousTypes) (always Nothing) docs.unions
+        ++ toPairs (viewValue modules ambiguousTypes) .assocPrec docs.values
+
+
+-- assumes the input list is sorted
+dropUniques : List String -> List String
+dropUniques list =
+  case list of
+    x :: y :: zs ->
+      if x == y then x :: dropUniques zs else dropUniques (y :: zs)              
+
+    _ ->
+      []
 
 
 -- MODEL
@@ -39,6 +53,37 @@ type alias Documentation =
     }
 
 
+mentionedTypes : Documentation -> List (String, String)
+mentionedTypes { name, aliases, unions, values } =
+  let
+    moduleName = name
+
+    extractFromAlias { name, tipe } =
+      (moduleName ++ ".", name) :: extractQualifiersAndType tipe
+
+    extractFromUnion { name, cases } =
+      (moduleName ++ ".", name) :: List.concatMap (List.concatMap extractQualifiersAndType << snd) cases
+
+    extractFromValue { tipe } =
+      extractQualifiersAndType tipe
+  in
+    List.concat <|
+      List.map extractFromAlias aliases
+      ++ List.map extractFromUnion unions
+      ++ List.map extractFromValue values
+
+
+extractQualifiersAndType : Type -> List (String, String)
+extractQualifiersAndType =
+  Regex.find Regex.All qualifiersAndType
+    >> List.map (.submatches >> \[Just qs, _, Just t] -> (qs, t))
+
+
+qualifiersAndType : Regex.Regex
+qualifiersAndType =
+  Regex.regex "(([A-Z][A-Za-z1-9_]*\\.)*)([A-Z][A-Za-z1-9_]*)"
+
+
 documentation : Decoder Documentation
 documentation =
   object5 Documentation
@@ -206,26 +251,26 @@ viewEntry innerWidth name (annotation, maybeAssocPrec, comment) =
 
 -- VIEW ALIASES
 
-viewAlias : List String -> Alias -> Text.Text
-viewAlias modules alias =
+viewAlias : List String -> List String -> Alias -> Text.Text
+viewAlias modules ambiguousTypes alias =
   Text.concat
     [ green "type alias "
     , Text.link ("#" ++ alias.name) (Text.bold (Text.fromString alias.name))
     , Text.fromString (String.concat (List.map ((++) " ") alias.args))
     , green " = "
     , case String.uncons alias.tipe of
         Just ('{', _) ->
-          viewRecordType modules alias.tipe
+          viewRecordType modules ambiguousTypes alias.tipe
 
         _ ->
-          typeToText modules alias.tipe
+          typeToText modules ambiguousTypes alias.tipe
     ]
 
 
 -- VIEW UNIONS
 
-viewUnion : List String -> Union -> Text.Text
-viewUnion modules union =
+viewUnion : List String -> List String -> Union -> Text.Text
+viewUnion modules ambiguousTypes union =
   let
     seperators =
       green "\n    = "
@@ -235,37 +280,37 @@ viewUnion modules union =
       [ green "type "
       , Text.link ("#" ++ union.name) (Text.bold (Text.fromString union.name))
       , Text.fromString (String.concat (List.map ((++) " ") union.args))
-      , Text.concat (List.map2 (++) seperators (List.map (viewCase modules) union.cases))
+      , Text.concat (List.map2 (++) seperators (List.map (viewCase modules ambiguousTypes) union.cases))
       ]
 
 
-viewCase : List String -> (String, List Type) -> Text.Text
-viewCase modules (tag, args) =
-  List.map (viewArg modules) args
+viewCase : List String -> List String -> (String, List Type) -> Text.Text
+viewCase modules ambiguousTypes (tag, args) =
+  List.map (viewArg modules ambiguousTypes) args
     |> (::) (Text.fromString tag)
     |> List.intersperse (Text.fromString " ")
     |> Text.concat
 
 
-viewArg : List String -> String -> Text.Text
-viewArg modules tipe =
+viewArg : List String -> List String -> String -> Text.Text
+viewArg modules ambiguousTypes tipe =
   let
     (Just (c,_)) =
       String.uncons tipe
   in
     if c == '(' || c == '{' || not (String.contains " " tipe) then
-      typeToText modules tipe
+      typeToText modules ambiguousTypes tipe
     else
-      typeToText modules ("(" ++ tipe ++ ")")
+      typeToText modules ambiguousTypes ("(" ++ tipe ++ ")")
 
 
 -- VIEW VALUES
 
-viewValue : List String -> Value -> Text.Text
-viewValue modules value =
+viewValue : List String -> List String -> Value -> Text.Text
+viewValue modules ambiguousTypes value =
   Text.concat
     [ Text.link ("#" ++ value.name) (Text.bold (viewVar value.name))
-    , viewFunctionType modules value.tipe
+    , viewFunctionType modules ambiguousTypes value.tipe
     ]
 
 
@@ -287,17 +332,17 @@ isVarChar c =
 
 -- VIEW TYPES
 
-viewRecordType : List String -> String -> Text.Text
-viewRecordType modules tipe =
+viewRecordType : List String -> List String -> String -> Text.Text
+viewRecordType modules ambiguousTypes tipe =
   splitRecord tipe
-    |> List.map (Text.append (Text.fromString "\n    ") << typeToText modules)
+    |> List.map (Text.append (Text.fromString "\n    ") << typeToText modules ambiguousTypes)
     |> Text.concat
 
 
-viewFunctionType : List String -> Type -> Text.Text
-viewFunctionType modules tipe =
+viewFunctionType : List String -> List String -> Type -> Text.Text
+viewFunctionType modules ambiguousTypes tipe =
   if String.length (dropQualifiers tipe) < 80 then
-    green " : " ++ typeToText modules tipe
+    green " : " ++ typeToText modules ambiguousTypes tipe
   else
     let
       parts =
@@ -307,13 +352,13 @@ viewFunctionType modules tipe =
         green "\n    :  "
         :: List.repeat (List.length parts - 1) (green "\n    ->")
     in
-      Text.concat (List.map2 (\sep -> Text.append sep << typeToText modules) seperators parts)
+      Text.concat (List.map2 (\sep -> Text.append sep << typeToText modules ambiguousTypes) seperators parts)
 
 
 -- TYPE TO TEXT
 
-typeToText : List String -> String -> Text.Text
-typeToText modules =
+typeToText : List String -> List String -> String -> Text.Text
+typeToText modules ambiguousTypes =
   replaceMap " " (Text.fromString " ")
     <| replaceMap "," (Text.fromString ",")
     <| replaceMap "(" (Text.fromString "(")
@@ -322,7 +367,7 @@ typeToText modules =
     <| replaceMap "}" (Text.fromString "}")
     <| replaceMap "->" (green "->")
     <| replaceMap ":" (green ":")
-    <| linkQualified modules
+    <| linkQualified modules ambiguousTypes
 
 
 replaceMap : String -> Text.Text -> (String -> Text.Text) -> String -> Text.Text
@@ -332,20 +377,27 @@ replaceMap s t f =
     >> Text.join t
 
 
-linkQualified : List String -> String -> Text.Text
-linkQualified modules token =
+linkQualified : List String -> List String -> String -> Text.Text
+linkQualified modules ambiguousTypes token =
   case List.reverse (String.split "." token) of
     name :: rest ->
       let
         qualifiers = List.reverse rest
+
+        nameToShow =
+          if List.member name ambiguousTypes
+          then
+            token
+          else
+            name
       in
         if List.member (String.join "." qualifiers) modules
         then
           Text.link
             (String.join "-" qualifiers ++ "#" ++ name)
-            (Text.fromString name)
+            (Text.fromString nameToShow)
         else
-          Text.fromString name
+          Text.fromString nameToShow
 
 
 dropQualifiers : String -> String

frontend/Component/Module.elm

@@ -12,13 +12,13 @@ import Component.Documentation as D
 import Component.Header as Header
 
 
-view : Signal.Address String -> Int -> String -> String -> String -> List String -> List String -> D.Documentation -> Element
-view versionAddr innerWidth user package version versionList modules docs =
+view : Signal.Address String -> Int -> String -> String -> String -> List String -> List String -> List (String, String) -> D.Documentation -> Element
+view versionAddr innerWidth user package version versionList modules mentionedTypes docs =
     flow down
     [ Header.view versionAddr innerWidth user package version versionList (Just docs.name)
     , color C.lightGrey (spacer innerWidth 1)
     , spacer innerWidth 12
-    , viewDocs innerWidth (D.toDocDict modules docs) docs.comment
+    , viewDocs innerWidth (D.toDocDict modules mentionedTypes docs) docs.comment
     ]
 
 

frontend/Page/Module.elm

@@ -9,6 +9,7 @@ import Http
 import String
 import Task exposing (Task, andThen, onError, succeed)
 import Window
+import Set
 
 import Component.TopBar as TopBar
 import Component.Module as Module
@@ -63,7 +64,7 @@ dummyDocs msg =
 
 main : Signal Element
 main =
-    Signal.map3 view Window.dimensions moduleList.signal documentation.signal
+    Signal.map3 view Window.dimensions modulesAndMentionedTypes.signal documentation.signal
 
 
 version : Signal.Mailbox String
@@ -82,35 +83,38 @@ port docsLoaded =
   Signal.map (always ()) documentation.signal
 
 
-port getModuleList : Task x ()
-port getModuleList =
+port getModulesAndMentionedTypes : Task x ()
+port getModulesAndMentionedTypes =
   let
     get =
-      Http.get (Json.list D.valueList) (packageUrl context.version ++ "/documentation.json")
+      Http.get (Json.list D.documentation) (packageUrl context.version ++ "/documentation.json")
 
     recover _ =
       Task.succeed []
 
+    removeDuplicates =
+      Set.toList << Set.fromList
+
     send list =
-      Signal.send moduleList.address (List.map fst list)
+      Signal.send modulesAndMentionedTypes.address (List.map .name list, removeDuplicates (List.concatMap D.mentionedTypes list))
   in
     (get `onError` recover) `andThen` send
 
 
-moduleList : Signal.Mailbox (List String)
-moduleList =
-  Signal.mailbox []
+modulesAndMentionedTypes : Signal.Mailbox (List String, List (String, String))
+modulesAndMentionedTypes =
+  Signal.mailbox ([], [])
 
 
-view : (Int,Int) -> List String -> D.Documentation -> Element
-view (windowWidth, windowHeight) modules docs =
+view : (Int,Int) -> (List String, List (String, String)) -> D.Documentation -> Element
+view (windowWidth, windowHeight) (modules, mentionedTypes) docs =
   let innerWidth = min 980 windowWidth
   in
     color C.background <|
     flow down
     [ TopBar.view windowWidth
     , flow right
       [ spacer ((windowWidth - innerWidth) // 2) (windowHeight - TopBar.topBarHeight)
-      , Module.view version.address innerWidth context.user context.name context.version context.versionList modules docs
+      , Module.view version.address innerWidth context.user context.name context.version context.versionList modules mentionedTypes docs
       ]
     ]