git.iko.soy/elk
on master help sign in
Make Transform.Interface a bit easier to read
commita1aa92ab997dd19543f6fb0f12202796a2812f2e authorEvan Czaplicki <info@elm-lang.org> dateSun 23 Nov 2014, 22:40 (12 years ago) parent4318f09
2 files changed+88−43
compare with master
unifiedsplit
src/AST/Variable.hs+42 src/Transform/Interface.hs+46−43
src/AST/Variable.hs+42
@@ -3,6 +3,7 @@ module AST.Variable where
33import Control.Applicative ((<$>), (<*>))
44import Data.Binary
55import qualified Data.List as List
6+import qualified Data.Maybe as Maybe
67import Text.PrettyPrint as P
78import qualified AST.Helpers as Help
89import AST.PrettyPrint
@@ -133,6 +134,47 @@ data Value
133134 deriving (Eq,Ord,Show)
134135
135136
137+-- CATEGORIZING VALUES
138+
139+getValues :: [Value] -> [String]
140+getValues values =
141+ Maybe.mapMaybe getValue values
142+
143+
144+getValue :: Value -> Maybe String
145+getValue value =
146+ case value of
147+ Value name -> Just name
148+ Alias _ -> Nothing
149+ Union _ _ -> Nothing
150+
151+
152+getAliases :: [Value] -> [String]
153+getAliases values =
154+ Maybe.mapMaybe getAlias values
155+
156+
157+getAlias :: Value -> Maybe String
158+getAlias value =
159+ case value of
160+ Value _-> Nothing
161+ Alias name -> Just name
162+ Union _ _ -> Nothing
163+
164+
165+getUnions :: [Value] -> [(String, Listing String)]
166+getUnions values =
167+ Maybe.mapMaybe getUnion values
168+
169+
170+getUnion :: Value -> Maybe (String, Listing String)
171+getUnion value =
172+ case value of
173+ Value _ -> Nothing
174+ Alias _ -> Nothing
175+ Union name ctors -> Just (name, ctors)
176+
177+
136178-- PRETTY VARIABLES
137179
138180instance Pretty Raw where
src/Transform/Interface.hs+46−43
@@ -1,57 +1,60 @@
11module Transform.Interface (filterExports) where
22
33import qualified Data.Map as Map
4+import qualified Data.Maybe as Maybe
45import qualified AST.Module as Module
5−import qualified AST.Type as Type
66import qualified AST.Variable as Var
77
8+
89filterExports :: Module.Interface -> Module.Interface
910filterExports interface =
1011 interface
1112 { Module.iTypes =
12− Map.fromList (concatMap getTypes exportedValues)
13+ Map.fromList $
14+ Maybe.mapMaybe
15+ (get (Module.iTypes interface))
16+ (Var.getValues exports ++ ctors)
17+
1318 , Module.iAliases =
14− Map.fromList (concatMap getAliases exportedValues)
19+ Map.fromList $
20+ Maybe.mapMaybe
21+ (get (Module.iAliases interface))
22+ (Var.getAliases exports)
23+
1524 , Module.iAdts =
16− Map.fromList (concatMap getAdts exportedValues)
25+ Map.fromList
26+ (Maybe.mapMaybe (trimUnions interface) unions)
1727 }
1828 where
19− exportedValues :: [Var.Value]
20− exportedValues = Module.iExports interface
21−
22− get :: Map.Map String a -> String -> [(String, a)]
23− get dict x =
24− case Map.lookup x dict of
25− Just t -> [(x,t)]
26− Nothing -> []
27−
28− getTypes :: Var.Value -> [(String, Type.CanonicalType)]
29− getTypes value =
30− case value of
31− Var.Value x -> getType x
32− Var.Alias _ -> []
33− Var.Union _ (Var.Listing ctors _) -> concatMap getType ctors
34−
35− getType :: String -> [(String, Type.CanonicalType)]
36− getType name =
37− get (Module.iTypes interface) name
38−
39− getAliases :: Var.Value -> [(String, ([String], Type.CanonicalType))]
40− getAliases value =
41− case value of
42− Var.Value _ -> []
43− Var.Alias name -> get (Module.iAliases interface) name
44− Var.Union _ _ -> []
45−
46− getAdts :: Var.Value -> [(String, Module.AdtInfo String)]
47− getAdts value =
48− case value of
49− Var.Value _ -> []
50− Var.Alias _ -> []
51− Var.Union name (Var.Listing exportedCtors _) ->
52− case Map.lookup name (Module.iAdts interface) of
53− Nothing -> []
54− Just (tvars, ctors) ->
55− [(name, (tvars, filter isExported ctors))]
56− where
57− isExported (ctor, _) = ctor `elem` exportedCtors
29+ exports :: [Var.Value]
30+ exports =
31+ Module.iExports interface
32+
33+ unions :: [(String, Var.Listing String)]
34+ unions =
35+ Var.getUnions exports
36+
37+ ctors :: [String]
38+ ctors =
39+ concatMap (\(_, Var.Listing ctorList _) -> ctorList) unions
40+
41+
42+get :: Map.Map String a -> String -> Maybe (String, a)
43+get dict key =
44+ case Map.lookup key dict of
45+ Nothing -> Nothing
46+ Just value -> Just (key, value)
47+
48+
49+trimUnions
50+ :: Module.Interface
51+ -> (String, Var.Listing String)
52+ -> Maybe (String, Module.AdtInfo String)
53+trimUnions interface (name, Var.Listing exportedCtors _) =
54+ case Map.lookup name (Module.iAdts interface) of
55+ Nothing -> Nothing
56+ Just (tvars, ctors) ->
57+ let isExported (ctor, _) =
58+ ctor `elem` exportedCtors
59+ in
60+ Just (name, (tvars, filter isExported ctors))