@@ -1,62 +1,59 @@
11{-# OPTIONS_GHC -Wall #-}
22module Elm.Interface
3− ( Interfaces
4− , Interface(..)
5− , Union
6− , Alias
3+ ( Interface(..)
4+ , Union(..)
5+ , Alias(..)
76 , Binop(..)
87 , fromModule
98 , toPublicUnion
109 , toPublicAlias
11− , toUnionInternals
12− , toAliasInternals
10+ , DependencyInterface(..)
11+ , public
12+ , private
13+ , privatize
1314 )
1415 where
1516
1617
17−import Control.Monad (liftM4)
18+import Control.Monad (liftM, liftM2, liftM4, liftM5)
1819import Data.Binary
19−import Data.Map ((!))
20−import qualified Data.Map as Map
20+import Data.Map.Strict ((!))
21+import qualified Data.Map.Strict as Map
2122import qualified Data.Map.Merge.Strict as Map
2223import qualified Data.Name as Name
2324
2425import qualified AST.Canonical as Can
2526import qualified AST.Utils.Binop as Binop
26−import qualified Elm.ModuleName as ModuleName
27+import qualified Elm.Package as Pkg
2728import qualified Reporting.Annotation as A
2829
2930
3031
31−-- INTERFACES
32−
33−
34−type Interfaces =
35− Map.Map ModuleName.Canonical Interface
36−
37−
38−
3932-- INTERFACE
4033
4134
4235data Interface =
4336 Interface
44− { _types :: Map.Map Name.Name Can.Annotation
37+ { _home :: Pkg.Name
38+ , _values :: Map.Map Name.Name Can.Annotation
4539 , _unions :: Map.Map Name.Name Union
4640 , _aliases :: Map.Map Name.Name Alias
4741 , _binops :: Map.Map Name.Name Binop
4842 }
43+ deriving (Eq)
4944
5045
5146data Union
5247 = OpenUnion Can.Union
5348 | ClosedUnion Can.Union
5449 | PrivateUnion Can.Union
50+ deriving (Eq)
5551
5652
5753data Alias
5854 = PublicAlias Can.Alias
5955 | PrivateAlias Can.Alias
56+ deriving (Eq)
6057
6158
6259data Binop =
@@ -66,24 +63,26 @@ data Binop =
6663 , _op_associativity :: Binop.Associativity
6764 , _op_precedence :: Binop.Precedence
6865 }
66+ deriving (Eq)
6967
7068
7169
7270-- FROM MODULE
7371
7472
75−fromModule :: Map.Map Name.Name Can.Annotation -> Can.Module -> Interface
76−fromModule types (Can.Module _ _ exports _ unions aliases binops _) =
73+fromModule :: Pkg.Name -> Can.Module -> Map.Map Name.Name Can.Annotation -> Interface
74+fromModule home (Can.Module _ exports _ unions aliases binops _) annotations =
7775 Interface
78− { _types = privatize exports types
79− , _unions = privatizeUnions exports unions
80− , _aliases = privatizeAliases exports aliases
81− , _binops = privatize exports (Map.map (toOp types) binops)
76+ { _home = home
77+ , _values = restrict exports annotations
78+ , _unions = restrictUnions exports unions
79+ , _aliases = restrictAliases exports aliases
80+ , _binops = restrict exports (Map.map (toOp annotations) binops)
8281 }
8382
8483
85−privatize :: Can.Exports -> Map.Map Name.Name a -> Map.Map Name.Name a
86−privatize exports dict =
84+restrict :: Can.Exports -> Map.Map Name.Name a -> Map.Map Name.Name a
85+restrict exports dict =
8786 case exports of
8887 Can.ExportEverything _ ->
8988 dict
@@ -97,8 +96,8 @@ toOp types (Can.Binop_ associativity precedence name) =
9796 Binop name (types ! name) associativity precedence
9897
9998
100−privatizeUnions :: Can.Exports -> Map.Map Name.Name Can.Union -> Map.Map Name.Name Union
101−privatizeUnions exports unions =
99+restrictUnions :: Can.Exports -> Map.Map Name.Name Can.Union -> Map.Map Name.Name Union
100+restrictUnions exports unions =
102101 case exports of
103102 Can.ExportEverything _ ->
104103 Map.map OpenUnion unions
@@ -107,16 +106,16 @@ privatizeUnions exports unions =
107106 Map.merge onLeft onRight onBoth explicitExports unions
108107 where
109108 onLeft = Map.dropMissing
110− onRight = Map.mapMissing (\_ u -> PrivateUnion u)
111− onBoth = Map.zipWithMatched $ \_ e u ->
112− case A.toValue e of
113− Can.ExportUnionOpen -> OpenUnion u
114− Can.ExportUnionClosed -> ClosedUnion u
115− _ -> error "impossible exports discovered in privatizeUnions"
109+ onRight = Map.mapMissing (\_ union -> PrivateUnion union)
110+ onBoth = Map.zipWithMatched $ \_ (A.At _ export) union ->
111+ case export of
112+ Can.ExportUnionOpen -> OpenUnion union
113+ Can.ExportUnionClosed -> ClosedUnion union
114+ _ -> error "impossible exports discovered in restrictUnions"
116115
117116
118−privatizeAliases :: Can.Exports -> Map.Map Name.Name Can.Alias -> Map.Map Name.Name Alias
119−privatizeAliases exports aliases =
117+restrictAliases :: Can.Exports -> Map.Map Name.Name Can.Alias -> Map.Map Name.Name Alias
118+restrictAliases exports aliases =
120119 case exports of
121120 Can.ExportEverything _ ->
122121 Map.map PublicAlias aliases
@@ -130,61 +129,74 @@ privatizeAliases exports aliases =
130129
131130
132131
133−-- PUBLICIZE
132+-- TO PUBLIC
134133
135134
136135toPublicUnion :: Union -> Maybe Can.Union
137136toPublicUnion iUnion =
138137 case iUnion of
139− OpenUnion union ->
140− Just union
141−
142− ClosedUnion (Can.Union vars _ _ opts) ->
143− Just (Can.Union vars [] 0 opts)
144−
145− PrivateUnion _ ->
146− Nothing
138+ OpenUnion union -> Just union
139+ ClosedUnion (Can.Union vars _ _ opts) -> Just (Can.Union vars [] 0 opts)
140+ PrivateUnion _ -> Nothing
147141
148142
149143toPublicAlias :: Alias -> Maybe Can.Alias
150144toPublicAlias iAlias =
151145 case iAlias of
152− PublicAlias alias ->
153− Just alias
146+ PublicAlias alias -> Just alias
147+ PrivateAlias _ -> Nothing
148+
149+
150+
151+-- DEPENDENCY INTERFACE
152+
153+
154+data DependencyInterface
155+ = Public Interface
156+ | Private (Map.Map Name.Name Can.Union) (Map.Map Name.Name Can.Alias)
154157
155− PrivateAlias _ ->
156− Nothing
157158
159+public :: Interface -> DependencyInterface
160+public =
161+ Public
158162
159163
160−-- INTERNALS
164+private :: Interface -> DependencyInterface
165+private (Interface _ _ unions aliases _) =
166+ Private
167+ (Map.map extractUnion unions)
168+ (Map.map extractAlias aliases)
161169
162170
163−toUnionInternals :: Union -> Can.Union
164−toUnionInternals iUnion =
171+extractUnion :: Union -> Can.Union
172+extractUnion iUnion =
165173 case iUnion of
166174 OpenUnion union -> union
167175 ClosedUnion union -> union
168176 PrivateUnion union -> union
169177
170178
171−toAliasInternals :: Alias -> Can.Alias
172−toAliasInternals iAlias =
179+extractAlias :: Alias -> Can.Alias
180+extractAlias iAlias =
173181 case iAlias of
174182 PublicAlias alias -> alias
175183 PrivateAlias alias -> alias
176184
177185
186+privatize :: DependencyInterface -> DependencyInterface
187+privatize di =
188+ case di of
189+ Public i -> private i
190+ Private _ _ -> di
191+
192+
178193
179194-- BINARY
180195
181196
182197instance Binary Interface where
183− get =
184− liftM4 Interface get get get get
185−
186− put (Interface a b c d) =
187− put a >> put b >> put c >> put d
198+ get = liftM5 Interface get get get get get
199+ put (Interface a b c d e) = put a >> put b >> put c >> put d >> put e
188200
189201
190202instance Binary Union where
@@ -197,9 +209,9 @@ instance Binary Union where
197209 get =
198210 do n <- getWord8
199211 case n of
200− 0 -> OpenUnion <$> get
201− 1 -> ClosedUnion <$> get
202− 2 -> PrivateUnion <$> get
212+ 0 -> liftM OpenUnion get
213+ 1 -> liftM ClosedUnion get
214+ 2 -> liftM PrivateUnion get
203215 _ -> error "binary encoding of Union was corrupted"
204216
205217
@@ -212,8 +224,8 @@ instance Binary Alias where
212224 get =
213225 do n <- getWord8
214226 case n of
215− 0 -> PublicAlias <$> get
216− 1 -> PrivateAlias <$> get
227+ 0 -> liftM PublicAlias get
228+ 1 -> liftM PrivateAlias get
217229 _ -> error "binary encoding of Alias was corrupted"
218230
219231
@@ -224,3 +236,16 @@ instance Binary Binop where
224236 put (Binop a b c d) =
225237 put a >> put b >> put c >> put d
226238
239+
240+instance Binary DependencyInterface where
241+ put union =
242+ case union of
243+ Public a -> putWord8 0 >> put a
244+ Private a b -> putWord8 1 >> put a >> put b
245+
246+ get =
247+ do n <- getWord8
248+ case n of
249+ 0 -> liftM Public get
250+ 1 -> liftM2 Private get get
251+ _ -> error "binary encoding of DependencyInterface was corrupted"