module Language.PureScript.Ide.Reexports
( resolveReexports
, prettyPrintReexportResult
, reexportHasFailures
, ReexportResult(..)
) where
import Protolude
import qualified Data.Map as Map
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
import qualified Language.PureScript as P
data ReexportResult a
= ReexportResult
{ reResolved :: a
, reFailed :: [(P.ModuleName, P.DeclarationRef)]
} deriving (Show, Eq, Functor)
prettyPrintReexportResult
:: (a -> Text)
-> ReexportResult a
-> Text
prettyPrintReexportResult f ReexportResult{..}
| null reFailed =
"Successfully resolved reexports for " <> f reResolved
| otherwise =
"Failed to resolve reexports for "
<> f reResolved
<> foldMap (\(mn, ref) -> runModuleNameT mn <> show ref) reFailed
reexportHasFailures :: ReexportResult a -> Bool
reexportHasFailures = not . null . reFailed
resolveReexports
:: Map P.ModuleName [IdeDeclarationAnn]
-> (Module, [(P.ModuleName, P.DeclarationRef)])
-> ReexportResult Module
resolveReexports modules ((moduleName, decls), refs) =
ReexportResult (moduleName, decls <> concat resolvedRefs) failedRefs
where
(failedRefs, resolvedRefs) = partitionEithers (resolveRef' <$> refs)
resolveRef' x@(mn, r) = case Map.lookup mn modules of
Nothing -> Left x
Just decls' -> first (mn,) (resolveRef decls' r)
resolveRef
:: [IdeDeclarationAnn]
-> P.DeclarationRef
-> Either P.DeclarationRef [IdeDeclarationAnn]
resolveRef decls ref = case ref of
P.TypeRef tn mdtors ->
case findRef (\case IdeType name _ -> name == tn; _ -> False) of
Nothing -> Left ref
Just d -> Right $ d : case mdtors of
Nothing ->
findDtors tn
Just dtors -> mapMaybe lookupDtor dtors
P.ValueRef i ->
findWrapped (\case IdeValue i' _ -> i' == i; _ -> False)
P.TypeOpRef name ->
findWrapped (\case IdeTypeOperator n _ _ _ -> n == name; _ -> False)
P.ValueOpRef name ->
findWrapped (\case IdeValueOperator n _ _ _ -> n == name; _ -> False)
P.TypeClassRef name ->
findWrapped (\case IdeTypeClass n -> n == name; _ -> False)
_ ->
Left ref
where
findWrapped = wrapSingle . findRef
wrapSingle = maybe (Left ref) (Right . pure)
findRef f = find (f . discardAnn) decls
lookupDtor name =
findRef (\case IdeDataConstructor name' _ _ -> name == name'
_ -> False)
findDtors tn = filter (f . discardAnn) decls
where
f :: IdeDeclaration -> Bool
f decl
| (IdeDataConstructor _ tn' _) <- decl
, tn == tn' = True
| otherwise = False