never executed always true always false

    1 module AST.MatchReferences (MatchedNamespace(..), fromMatched, matchReferences, applyReferences) where
    2 
    3 import AST.V0_16
    4 import AST.Structure
    5 import Control.Applicative ((<|>))
    6 import Data.Coapplicative
    7 import ElmFormat.ImportInfo (ImportInfo)
    8 
    9 import qualified Data.Bimap as Bimap
   10 import qualified Data.Map.Strict as Dict
   11 import qualified Data.Maybe as Maybe
   12 import qualified Data.Set as Set
   13 import qualified ElmFormat.ImportInfo as ImportInfo
   14 
   15 
   16 data MatchedNamespace t
   17     = Local
   18     | MatchedImport Bool t -- Bool is True if it was originally qualified
   19     | Unmatched t -- The given namespace is clearly specified, but it is not a known import
   20     | UnmatchedUnqualified [t] -- An unqualified reference that doesn't match anything known. List is namespaces that we don't know the contents of that are possibilities for a match
   21     deriving (Eq, Ord, Show, Functor)
   22 
   23 
   24 fromMatched :: t -> MatchedNamespace t -> t
   25 fromMatched empty Local = empty
   26 fromMatched _ (MatchedImport _ t) = t
   27 fromMatched _ (Unmatched t) = t
   28 fromMatched empty (UnmatchedUnqualified _) = empty
   29 
   30 
   31 matchReferences ::
   32     (Coapplicative annf, Ord u) =>
   33     ImportInfo [u]
   34     -> ASTNS annf [u] kind
   35     -> ASTNS annf (MatchedNamespace [u]) kind
   36 matchReferences importInfo =
   37     let
   38         aliases = Bimap.toMap $ ImportInfo._aliases importInfo
   39         imports = ImportInfo._directImports importInfo
   40         exposed = ImportInfo._exposed importInfo
   41         unresolvedExposingAll = ImportInfo._unresolvedExposingAll importInfo
   42         unmatchedUnqualified = UnmatchedUnqualified $ Set.toList unresolvedExposingAll
   43 
   44         f locals ns identifier =
   45             case ns of
   46                 [] ->
   47                     case Dict.lookup identifier locals of
   48                         Just () -> Local
   49                         Nothing ->
   50                             case Dict.lookup identifier exposed of
   51                                 Nothing -> unmatchedUnqualified
   52                                 Just exposedFrom -> MatchedImport False exposedFrom
   53 
   54                 _ ->
   55                     let
   56                         self =
   57                             if Set.member ns imports then
   58                                 Just ns
   59                             else
   60                                 Nothing
   61 
   62                         fromAlias =
   63                             Dict.lookup ns aliases
   64 
   65                         resolved =
   66                             fromAlias <|> self
   67                     in
   68                     case resolved of
   69                         Nothing -> Unmatched ns
   70                         Just single -> MatchedImport True single
   71 
   72         defineLocal name = Dict.insert name ()
   73 
   74         mapTypeRef locals (ns, u) = (f locals ns (TypeName u), u)
   75         mapCtorRef locals (ns, u) = (f locals ns (CtorName u), u)
   76         mapVarRef locals (VarRef ns l) = VarRef (f locals ns (VarName l)) l
   77         mapVarRef locals (TagRef ns u) = TagRef (f locals ns (CtorName u)) u
   78         mapVarRef _ (OpRef op) = OpRef op
   79     in
   80     topDownReferencesWithContext
   81         defineLocal
   82         mapTypeRef mapCtorRef mapVarRef
   83         mempty
   84 
   85 
   86 applyReferences ::
   87     (Coapplicative annf, Ord u) =>
   88     ImportInfo [u]
   89     -> ASTNS annf (MatchedNamespace [u]) kind
   90     -> ASTNS annf [u] kind
   91 applyReferences importInfo =
   92     let
   93         aliases = Bimap.toMapR $ ImportInfo._aliases importInfo
   94         exposed = ImportInfo._exposed importInfo
   95         unresolvedExposingAll = ImportInfo._unresolvedExposingAll importInfo
   96 
   97         f locals ns' identifier =
   98             case ns' of
   99                 Local -> []
  100                 MatchedImport wasQualified ns ->
  101                     let
  102                         qualify =
  103                             case wasQualified of
  104                                 True ->
  105                                     (Dict.lookup identifier exposed /= Just ns) -- it's not exposed
  106                                     || Dict.member identifier locals -- something is locally defined with the same name
  107                                     || not (Set.null unresolvedExposingAll) -- there's an import with exposing(..) and we can't be sure if something exposed by that would conflict
  108                                 False ->
  109                                     (Dict.lookup identifier exposed /= Just ns) -- it's not exposed
  110                                     || Dict.member identifier locals -- something is locally defined with the same name
  111                     in
  112                     if qualify
  113                       then Maybe.fromMaybe ns $ Dict.lookup ns aliases
  114                       else [] -- This is exposed unambiguously and doesn't need to be qualified
  115                 Unmatched name -> name
  116                 UnmatchedUnqualified _ -> []
  117 
  118         defineLocal name = Dict.insert name ()
  119 
  120         mapTypeRef locals (ns, u) = (f locals ns (TypeName u), u)
  121         mapCtorRef locals (ns, u) = (f locals ns (CtorName u), u)
  122         mapVarRef locals (VarRef ns l) = VarRef (f locals ns (VarName l)) l
  123         mapVarRef locals (TagRef ns u) = TagRef (f locals ns (CtorName u)) u
  124         mapVarRef _ (OpRef op) = OpRef op
  125     in
  126     topDownReferencesWithContext
  127         defineLocal
  128         mapTypeRef mapCtorRef mapVarRef
  129         mempty