@@ -3,22 +3,32 @@ module Artifacts
33 ( Artifacts(..)
44 , loadCompile
55 , loadRepl
6+ , toEditorHints
67 )
78 where
89
910
1011import Control.Concurrent (readMVar)
1112import Control.Monad (liftM2)
13+import qualified Data.ByteString as BS
14+import qualified Data.ByteString.Builder as B
15+import qualified Data.ByteString.Lazy as LBS
1216import qualified Data.Map as Map
17+import qualified Data.Name as N
1318import qualified Data.OneOrMore as OneOrMore
1419import qualified System.Directory as Dir
1520import System.FilePath ((</>))
1621
22+import qualified AST.Canonical as Can
1723import qualified AST.Optimized as Opt
1824import qualified BackgroundWriter as BW
1925import qualified Elm.Details as Details
2026import qualified Elm.Interface as I
2127import qualified Elm.ModuleName as ModuleName
28+import qualified Elm.Package as Pkg
29+import Json.Encode ((==>))
30+import qualified Json.Encode as E
31+import qualified Json.String as Json
2232import qualified Reporting
2333
2434
@@ -90,3 +100,55 @@ toUnique oneOrMore =
90100 OneOrMore.One value -> Just value
91101 OneOrMore.More _ _ -> Nothing
92102
103+
104+
105+-- TO EDITOR HINTS
106+
107+
108+toEditorHints :: Artifacts -> BS.ByteString
109+toEditorHints (Artifacts ifaces _) =
110+ LBS.toStrict $ B.toLazyByteString $ E.encodeUgly $ encode ifaces
111+
112+
113+
114+-- ENCODE
115+
116+
117+encode :: Map.Map ModuleName.Raw I.Interface -> E.Value
118+encode ifaces =
119+ E.dict Json.fromName encodeInterface ifaces
120+
121+
122+encodeInterface :: I.Interface -> E.Value
123+encodeInterface (I.Interface pkg values unions aliases binops) =
124+ E.object
125+ [ "home" ==> E.chars (Pkg.toChars pkg)
126+ , "values" ==> E.list E.name (Map.keys binops ++ Map.keys values)
127+ , "aliases" ==> E.list E.name (Map.keys (Map.filter isPublicAlias aliases))
128+ , "types" ==> E.dict Json.fromName (E.list E.name) (Map.mapMaybe toPublicUnion unions)
129+ ]
130+
131+
132+isPublicAlias :: I.Alias -> Bool
133+isPublicAlias alias =
134+ case alias of
135+ I.PublicAlias _ -> True
136+ I.PrivateAlias _ -> False
137+
138+
139+toPublicUnion :: I.Union -> Maybe [N.Name]
140+toPublicUnion union =
141+ case union of
142+ I.OpenUnion (Can.Union _ variants _ _) ->
143+ Just (map getVariantName variants)
144+
145+ I.ClosedUnion _ ->
146+ Just []
147+
148+ I.PrivateUnion _ ->
149+ Nothing
150+
151+
152+getVariantName :: Can.Ctor -> N.Name
153+getVariantName (Can.Ctor name _ _ _) =
154+ name