never executed always true always false
1 module ElmFormat.ImportInfo (ImportInfo(..), fromModule, fromImports) where
2
3 import AST.V0_16
4 import AST.Listing (Listing(..), CommentedMap)
5 import Elm.Utils ((|>))
6
7 import AST.Module (Module, ImportMethod(..), DetailedListing(..))
8 import qualified AST.Module
9 import Data.Coapplicative
10 import qualified Data.Bimap as Bimap
11 import qualified Data.Map.Strict as Dict
12 import qualified Data.Maybe as Maybe
13 import qualified Data.Set as Set
14 import qualified ElmFormat.KnownContents as KnownContents
15 import ElmFormat.KnownContents (KnownContents)
16
17 data ImportInfo ns =
18 ImportInfo
19 { _exposed :: Dict.Map LocalName ns
20 , _aliases :: Bimap.Bimap ns ns
21 , _directImports :: Set.Set ns
22 , _ambiguous :: Dict.Map LocalName [ns]
23 , _unresolvedExposingAll :: Set.Set ns -- any modules with exposing(..) and we didn't know the module contents
24 }
25 deriving Show
26
27
28 fromModule ::
29 KnownContents
30 -> Module [UppercaseIdentifier] decl
31 -> ImportInfo [UppercaseIdentifier]
32 fromModule knownContents modu =
33 fromImports knownContents (fmap extract $ extract $ AST.Module.imports $ modu)
34
35
36 fromImports ::
37 KnownContents
38 -> Dict.Map [UppercaseIdentifier] ImportMethod
39 -> ImportInfo [UppercaseIdentifier]
40 fromImports knownContents rawImports =
41 let
42 defaultImports :: Dict.Map [UppercaseIdentifier] ImportMethod
43 defaultImports =
44 Dict.fromList $
45 fmap (\(m, i) -> (fmap UppercaseIdentifier m, ImportMethod Nothing (C ([], []) i)))
46 [ ( [ "Basics" ], OpenListing (C ([], []) ()) )
47 , ( [ "List" ], ClosedListing )
48 , ( [ "Maybe" ]
49 , ExplicitListing
50 (DetailedListing mempty mempty $
51 Dict.fromList
52 [ ( UppercaseIdentifier "Maybe"
53 , C ([], []) $ C [] $
54 ExplicitListing (Dict.fromList
55 [ (UppercaseIdentifier "Nothing", C ([], []) ())
56 , (UppercaseIdentifier "Just", C ([], []) ())
57 ]) False)]
58 )
59 False
60 )
61 ]
62
63 imports = Dict.union rawImports defaultImports -- NOTE: this MUST prefer rawImports when there is a duplicate key
64
65 -- these are things we know will get exposed for certain modules when we see "exposing (..)"
66 -- only things that are currently useful for Elm 0.19 upgrade are included
67 moduleContents :: [UppercaseIdentifier] -> [LocalName]
68 moduleContents moduleName =
69 case (\(UppercaseIdentifier x) -> x) <$> moduleName of
70 [ "Basics" ] ->
71 [ VarName $ LowercaseIdentifier "identity"
72 ]
73 [ "Html", "Attributes" ] ->
74 [ VarName $ LowercaseIdentifier "style"
75 ]
76 [ "List" ] ->
77 [ VarName $ LowercaseIdentifier "filterMap"
78 ]
79 [ "Maybe" ] ->
80 [ CtorName $ UppercaseIdentifier "Nothing"
81 , CtorName $ UppercaseIdentifier "Just"
82 ]
83 _ -> KnownContents.get moduleName knownContents |> Maybe.fromMaybe []
84
85 getExposed moduleName (ImportMethod _ (C _ listing)) =
86 Dict.fromList $ fmap (flip (,) moduleName) $
87 case listing of
88 ClosedListing -> []
89 OpenListing _ ->
90 moduleContents moduleName
91 ExplicitListing details _ ->
92 (fmap VarName $ Dict.keys $ AST.Module.values details)
93 <> (fmap TypeName $ Dict.keys $ AST.Module.types details)
94 <> (fmap CtorName $ foldMap (getCtorListings . extract . extract) $ Dict.elems $ AST.Module.types details)
95
96 getCtorListings :: Listing (CommentedMap name ()) -> [name]
97 getCtorListings = \case
98 ClosedListing -> []
99 OpenListing _ ->
100 -- TODO: exposing (Type(..)) should pull in variant names from knownContents, though this should also be a warning because we can't know for sure which of those are for this type
101 []
102 ExplicitListing ctors _ -> Dict.keys ctors
103
104 exposed =
105 -- TODO: mark ambiguous names if multiple modules expose them
106 Dict.foldlWithKey (\a k v -> Dict.union a $ getExposed k v) mempty imports
107
108 aliases =
109 let
110 getAlias importMethod =
111 case AST.Module.alias importMethod of
112 Just (C _ alias) ->
113 Just [alias]
114
115 Nothing -> Nothing
116
117 liftMaybe :: (a, Maybe b) -> Maybe (a, b)
118 liftMaybe (_, Nothing) = Nothing
119 liftMaybe (a, Just b) = Just (a, b)
120 in
121 Dict.toList imports
122 |> fmap (fmap getAlias)
123 |> Maybe.mapMaybe liftMaybe
124 |> fmap (\(a, b) -> (b, a))
125 |> Bimap.fromList
126
127 noAlias importMethod =
128 case AST.Module.alias importMethod of
129 Just _ -> False
130 Nothing -> True
131
132 directs =
133 Set.union
134 (Set.singleton [UppercaseIdentifier "Basics"])
135 (Dict.keysSet $ Dict.filter noAlias imports)
136
137 ambiguous = Dict.empty
138
139 exposesAll (ImportMethod _ (C _ listing)) =
140 case listing of
141 ExplicitListing _ _ -> False
142 OpenListing _ -> True
143 ClosedListing -> False
144
145 unresolvedExposingAll =
146 Dict.filter exposesAll rawImports
147 |> Dict.keysSet
148 |> Set.filter (not . KnownContents.isKnown knownContents)
149 in
150 ImportInfo exposed aliases directs ambiguous unresolvedExposingAll