module Language.PureScript.Ide.Reexports
( resolveReexports
, prettyPrintReexportResult
, reexportHasFailures
, ReexportResult(..)
) where
import Protolude
import Control.Lens hiding ((&))
import qualified Data.Map as Map
import qualified Language.PureScript as P
import Language.PureScript.Ide.Types
import Language.PureScript.Ide.Util
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) -> P.runModuleName 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 (\x -> x ^? _IdeDeclType . ideTypeName <&> (== tn) & fromMaybe False) of
Nothing -> Left ref
Just d -> Right $ d : case mdtors of
Nothing ->
findDtors tn
Just dtors -> mapMaybe lookupDtor dtors
P.ValueRef i ->
findWrapped (\x -> x ^? _IdeDeclValue . ideValueIdent <&> (== i) & fromMaybe False)
P.ValueOpRef name ->
findWrapped (\x -> x ^? _IdeDeclValueOperator . ideValueOpName <&> (== name) & fromMaybe False)
P.TypeOpRef name ->
findWrapped (\x -> x ^? _IdeDeclTypeOperator . ideTypeOpName <&> (== name) & fromMaybe False)
P.TypeClassRef name ->
findWrapped (\case IdeDeclTypeClass n -> n == name; _ -> False)
_ ->
Left ref
where
findWrapped = maybe (Left ref) (Right . pure) . findRef
findRef f = find (f . discardAnn) decls
lookupDtor name =
findRef (\x -> x ^? _IdeDeclDataConstructor . ideDtorName <&> (== name) & fromMaybe False)
findDtors tn = filter (f . discardAnn) decls
where
f :: IdeDeclaration -> Bool
f decl = decl ^? _IdeDeclDataConstructor . ideDtorTypeName <&> (== tn) & fromMaybe False