git.iko.soy/elk
on ff46029 help sign in
elk/compiler/src/Elm/Interface.hs
251 lines 5.9 kB history raw
1{-# OPTIONS_GHC -Wall #-}
2module Elm.Interface
3 ( Interface(..)
4 , Union(..)
5 , Alias(..)
6 , Binop(..)
7 , fromModule
8 , toPublicUnion
9 , toPublicAlias
10 , DependencyInterface(..)
11 , public
12 , private
13 , privatize
14 )
15 where
18import Control.Monad (liftM, liftM2, liftM4, liftM5)
19import Data.Binary
20import Data.Map.Strict ((!))
21import qualified Data.Map.Strict as Map
22import qualified Data.Map.Merge.Strict as Map
23import qualified Data.Name as Name
25import qualified AST.Canonical as Can
26import qualified AST.Utils.Binop as Binop
27import qualified Elm.Package as Pkg
28import qualified Reporting.Annotation as A
32-- INTERFACE
35data Interface =
36 Interface
37 { _home :: Pkg.Name
38 , _values :: Map.Map Name.Name Can.Annotation
39 , _unions :: Map.Map Name.Name Union
40 , _aliases :: Map.Map Name.Name Alias
41 , _binops :: Map.Map Name.Name Binop
42 }
43 deriving (Eq)
46data Union
47 = OpenUnion Can.Union
48 | ClosedUnion Can.Union
49 | PrivateUnion Can.Union
50 deriving (Eq)
53data Alias
54 = PublicAlias Can.Alias
55 | PrivateAlias Can.Alias
56 deriving (Eq)
59data Binop =
60 Binop
61 { _op_name :: Name.Name
62 , _op_annotation :: Can.Annotation
63 , _op_associativity :: Binop.Associativity
64 , _op_precedence :: Binop.Precedence
65 }
66 deriving (Eq)
70-- FROM MODULE
73fromModule :: Pkg.Name -> Can.Module -> Map.Map Name.Name Can.Annotation -> Interface
74fromModule home (Can.Module _ exports _ unions aliases binops _) annotations =
75 Interface
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)
81 }
84restrict :: Can.Exports -> Map.Map Name.Name a -> Map.Map Name.Name a
85restrict exports dict =
86 case exports of
87 Can.ExportEverything _ ->
88 dict
90 Can.Export explicitExports ->
91 Map.intersection dict explicitExports
94toOp :: Map.Map Name.Name Can.Annotation -> Can.Binop -> Binop
95toOp types (Can.Binop_ associativity precedence name) =
96 Binop name (types ! name) associativity precedence
99restrictUnions :: Can.Exports -> Map.Map Name.Name Can.Union -> Map.Map Name.Name Union
100restrictUnions exports unions =
101 case exports of
102 Can.ExportEverything _ ->
103 Map.map OpenUnion unions
105 Can.Export explicitExports ->
106 Map.merge onLeft onRight onBoth explicitExports unions
107 where
108 onLeft = Map.dropMissing
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"
117restrictAliases :: Can.Exports -> Map.Map Name.Name Can.Alias -> Map.Map Name.Name Alias
118restrictAliases exports aliases =
119 case exports of
120 Can.ExportEverything _ ->
121 Map.map PublicAlias aliases
123 Can.Export explicitExports ->
124 Map.merge onLeft onRight onBoth explicitExports aliases
125 where
126 onLeft = Map.dropMissing
127 onRight = Map.mapMissing (\_ a -> PrivateAlias a)
128 onBoth = Map.zipWithMatched (\_ _ a -> PublicAlias a)
132-- TO PUBLIC
135toPublicUnion :: Union -> Maybe Can.Union
136toPublicUnion iUnion =
137 case iUnion of
138 OpenUnion union -> Just union
139 ClosedUnion (Can.Union vars _ _ opts) -> Just (Can.Union vars [] 0 opts)
140 PrivateUnion _ -> Nothing
143toPublicAlias :: Alias -> Maybe Can.Alias
144toPublicAlias iAlias =
145 case iAlias of
146 PublicAlias alias -> Just alias
147 PrivateAlias _ -> Nothing
151-- DEPENDENCY INTERFACE
154data DependencyInterface
155 = Public Interface
156 | Private (Map.Map Name.Name Can.Union) (Map.Map Name.Name Can.Alias)
159public :: Interface -> DependencyInterface
160public =
161 Public
164private :: Interface -> DependencyInterface
165private (Interface _ _ unions aliases _) =
166 Private
167 (Map.map extractUnion unions)
168 (Map.map extractAlias aliases)
171extractUnion :: Union -> Can.Union
172extractUnion iUnion =
173 case iUnion of
174 OpenUnion union -> union
175 ClosedUnion union -> union
176 PrivateUnion union -> union
179extractAlias :: Alias -> Can.Alias
180extractAlias iAlias =
181 case iAlias of
182 PublicAlias alias -> alias
183 PrivateAlias alias -> alias
186privatize :: DependencyInterface -> DependencyInterface
187privatize di =
188 case di of
189 Public i -> private i
190 Private _ _ -> di
194-- BINARY
197instance Binary Interface where
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
202instance Binary Union where
203 put union =
204 case union of
205 OpenUnion u -> putWord8 0 >> put u
206 ClosedUnion u -> putWord8 1 >> put u
207 PrivateUnion u -> putWord8 2 >> put u
209 get =
210 do n <- getWord8
211 case n of
212 0 -> liftM OpenUnion get
213 1 -> liftM ClosedUnion get
214 2 -> liftM PrivateUnion get
215 _ -> error "binary encoding of Union was corrupted"
218instance Binary Alias where
219 put union =
220 case union of
221 PublicAlias a -> putWord8 0 >> put a
222 PrivateAlias a -> putWord8 1 >> put a
224 get =
225 do n <- getWord8
226 case n of
227 0 -> liftM PublicAlias get
228 1 -> liftM PrivateAlias get
229 _ -> error "binary encoding of Alias was corrupted"
232instance Binary Binop where
233 get =
234 liftM4 Binop get get get get
236 put (Binop a b c d) =
237 put a >> put b >> put c >> put d
240instance 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
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"