module AST.MatchReferences (MatchedNamespace(..), fromMatched, matchReferences, applyReferences) where

import AST.V0_16
import AST.Structure
import Control.Applicative ((<|>))
import Data.Coapplicative
import ElmFormat.ImportInfo (ImportInfo)

import qualified Data.Bimap as Bimap
import qualified Data.Map.Strict as Dict
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified ElmFormat.ImportInfo as ImportInfo


data MatchedNamespace t
    = Local
    | MatchedImport Bool t -- Bool is True if it was originally qualified
    | Unmatched t -- The given namespace is clearly specified, but it is not a known import
    | 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
    deriving (Eq, Ord, Show, Functor)


fromMatched :: t -> MatchedNamespace t -> t
fromMatched empty Local = empty
fromMatched _ (MatchedImport _ t) = t
fromMatched _ (Unmatched t) = t
fromMatched empty (UnmatchedUnqualified _) = empty


matchReferences ::
    (Coapplicative annf, Ord u) =>
    ImportInfo [u]
    -> ASTNS annf [u] kind
    -> ASTNS annf (MatchedNamespace [u]) kind
matchReferences importInfo =
    let
        aliases = Bimap.toMap $ ImportInfo._aliases importInfo
        imports = ImportInfo._directImports importInfo
        exposed = ImportInfo._exposed importInfo
        unresolvedExposingAll = ImportInfo._unresolvedExposingAll importInfo
        unmatchedUnqualified = UnmatchedUnqualified $ Set.toList unresolvedExposingAll

        f locals ns identifier =
            case ns of
                [] ->
                    case Dict.lookup identifier locals of
                        Just () -> Local
                        Nothing ->
                            case Dict.lookup identifier exposed of
                                Nothing -> unmatchedUnqualified
                                Just exposedFrom -> MatchedImport False exposedFrom

                _ ->
                    let
                        self =
                            if Set.member ns imports then
                                Just ns
                            else
                                Nothing

                        fromAlias =
                            Dict.lookup ns aliases

                        resolved =
                            fromAlias <|> self
                    in
                    case resolved of
                        Nothing -> Unmatched ns
                        Just single -> MatchedImport True single

        defineLocal name = Dict.insert name ()

        mapTypeRef locals (ns, u) = (f locals ns (TypeName u), u)
        mapCtorRef locals (ns, u) = (f locals ns (CtorName u), u)
        mapVarRef locals (VarRef ns l) = VarRef (f locals ns (VarName l)) l
        mapVarRef locals (TagRef ns u) = TagRef (f locals ns (CtorName u)) u
        mapVarRef _ (OpRef op) = OpRef op
    in
    topDownReferencesWithContext
        defineLocal
        mapTypeRef mapCtorRef mapVarRef
        mempty


applyReferences ::
    (Coapplicative annf, Ord u) =>
    ImportInfo [u]
    -> ASTNS annf (MatchedNamespace [u]) kind
    -> ASTNS annf [u] kind
applyReferences importInfo =
    let
        aliases = Bimap.toMapR $ ImportInfo._aliases importInfo
        exposed = ImportInfo._exposed importInfo
        unresolvedExposingAll = ImportInfo._unresolvedExposingAll importInfo

        f locals ns' identifier =
            case ns' of
                Local -> []
                MatchedImport wasQualified ns ->
                    let
                        qualify =
                            case wasQualified of
                                True ->
                                    (Dict.lookup identifier exposed /= Just ns) -- it's not exposed
                                    || Dict.member identifier locals -- something is locally defined with the same name
                                    || not (Set.null unresolvedExposingAll) -- there's an import with exposing(..) and we can't be sure if something exposed by that would conflict
                                False ->
                                    (Dict.lookup identifier exposed /= Just ns) -- it's not exposed
                                    || Dict.member identifier locals -- something is locally defined with the same name
                    in
                    if qualify
                      then Maybe.fromMaybe ns $ Dict.lookup ns aliases
                      else [] -- This is exposed unambiguously and doesn't need to be qualified
                Unmatched name -> name
                UnmatchedUnqualified _ -> []

        defineLocal name = Dict.insert name ()

        mapTypeRef locals (ns, u) = (f locals ns (TypeName u), u)
        mapCtorRef locals (ns, u) = (f locals ns (CtorName u), u)
        mapVarRef locals (VarRef ns l) = VarRef (f locals ns (VarName l)) l
        mapVarRef locals (TagRef ns u) = TagRef (f locals ns (CtorName u)) u
        mapVarRef _ (OpRef op) = OpRef op
    in
    topDownReferencesWithContext
        defineLocal
        mapTypeRef mapCtorRef mapVarRef
        mempty
