module Language.PureScript.Ide.Reexports
( resolveReexports
, prettyPrintReexportResult
, reexportHasFailures
, ReexportResult(..)
, resolveReexports'
) where
import Protolude hiding (moduleName)
import Control.Lens hiding (anyOf, (&))
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
{ forall a. ReexportResult a -> a
reResolved :: a
, forall a. ReexportResult a -> [(ModuleName, DeclarationRef)]
reFailed :: [(P.ModuleName, P.DeclarationRef)]
} deriving (Int -> ReexportResult a -> ShowS
forall a. Show a => Int -> ReexportResult a -> ShowS
forall a. Show a => [ReexportResult a] -> ShowS
forall a. Show a => ReexportResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReexportResult a] -> ShowS
$cshowList :: forall a. Show a => [ReexportResult a] -> ShowS
show :: ReexportResult a -> String
$cshow :: forall a. Show a => ReexportResult a -> String
showsPrec :: Int -> ReexportResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ReexportResult a -> ShowS
Show, ReexportResult a -> ReexportResult a -> Bool
forall a. Eq a => ReexportResult a -> ReexportResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReexportResult a -> ReexportResult a -> Bool
$c/= :: forall a. Eq a => ReexportResult a -> ReexportResult a -> Bool
== :: ReexportResult a -> ReexportResult a -> Bool
$c== :: forall a. Eq a => ReexportResult a -> ReexportResult a -> Bool
Eq, forall a b. a -> ReexportResult b -> ReexportResult a
forall a b. (a -> b) -> ReexportResult a -> ReexportResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ReexportResult b -> ReexportResult a
$c<$ :: forall a b. a -> ReexportResult b -> ReexportResult a
fmap :: forall a b. (a -> b) -> ReexportResult a -> ReexportResult b
$cfmap :: forall a b. (a -> b) -> ReexportResult a -> ReexportResult b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ReexportResult a) x -> ReexportResult a
forall a x. ReexportResult a -> Rep (ReexportResult a) x
$cto :: forall a x. Rep (ReexportResult a) x -> ReexportResult a
$cfrom :: forall a x. ReexportResult a -> Rep (ReexportResult a) x
Generic)
instance NFData a => NFData (ReexportResult a)
prettyPrintReexportResult
:: (a -> Text)
-> ReexportResult a
-> Text
prettyPrintReexportResult :: forall a. (a -> Text) -> ReexportResult a -> Text
prettyPrintReexportResult a -> Text
f ReexportResult{a
[(ModuleName, DeclarationRef)]
reFailed :: [(ModuleName, DeclarationRef)]
reResolved :: a
reFailed :: forall a. ReexportResult a -> [(ModuleName, DeclarationRef)]
reResolved :: forall a. ReexportResult a -> a
..}
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ModuleName, DeclarationRef)]
reFailed =
Text
"Successfully resolved reexports for " forall a. Semigroup a => a -> a -> a
<> a -> Text
f a
reResolved
| Bool
otherwise =
Text
"Failed to resolve reexports for "
forall a. Semigroup a => a -> a -> a
<> a -> Text
f a
reResolved
forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(ModuleName
mn, DeclarationRef
ref) -> ModuleName -> Text
P.runModuleName ModuleName
mn forall a. Semigroup a => a -> a -> a
<> forall a b. (Show a, StringConv String b) => a -> b
show DeclarationRef
ref) [(ModuleName, DeclarationRef)]
reFailed
reexportHasFailures :: ReexportResult a -> Bool
reexportHasFailures :: forall a. ReexportResult a -> Bool
reexportHasFailures = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ReexportResult a -> [(ModuleName, DeclarationRef)]
reFailed
resolveReexports
:: ModuleMap [(P.ModuleName, P.DeclarationRef)]
-> ModuleMap [IdeDeclarationAnn]
-> ModuleMap (ReexportResult [IdeDeclarationAnn])
resolveReexports :: ModuleMap [(ModuleName, DeclarationRef)]
-> ModuleMap [IdeDeclarationAnn]
-> ModuleMap (ReexportResult [IdeDeclarationAnn])
resolveReexports ModuleMap [(ModuleName, DeclarationRef)]
reexportRefs ModuleMap [IdeDeclarationAnn]
modules =
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\ModuleName
moduleName [IdeDeclarationAnn]
decls ->
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> [(ModuleName, DeclarationRef)] -> ReexportResult a
ReexportResult [IdeDeclarationAnn]
decls [])
(forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ([IdeDeclarationAnn]
decls forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleMap [IdeDeclarationAnn]
-> [(ModuleName, DeclarationRef)]
-> ReexportResult [IdeDeclarationAnn]
resolveReexports' ModuleMap [IdeDeclarationAnn]
modules)
(forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
moduleName ModuleMap [(ModuleName, DeclarationRef)]
reexportRefs)) ModuleMap [IdeDeclarationAnn]
modules
resolveReexports'
:: ModuleMap [IdeDeclarationAnn]
-> [(P.ModuleName, P.DeclarationRef)]
-> ReexportResult [IdeDeclarationAnn]
resolveReexports' :: ModuleMap [IdeDeclarationAnn]
-> [(ModuleName, DeclarationRef)]
-> ReexportResult [IdeDeclarationAnn]
resolveReexports' ModuleMap [IdeDeclarationAnn]
modules [(ModuleName, DeclarationRef)]
refs =
forall a. a -> [(ModuleName, DeclarationRef)] -> ReexportResult a
ReexportResult (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[IdeDeclarationAnn]]
resolvedRefs) [(ModuleName, DeclarationRef)]
failedRefs
where
([(ModuleName, DeclarationRef)]
failedRefs, [[IdeDeclarationAnn]]
resolvedRefs) = forall a b. [Either a b] -> ([a], [b])
partitionEithers ((ModuleName, DeclarationRef)
-> Either (ModuleName, DeclarationRef) [IdeDeclarationAnn]
resolveRef' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ModuleName, DeclarationRef)]
refs)
resolveRef' :: (ModuleName, DeclarationRef)
-> Either (ModuleName, DeclarationRef) [IdeDeclarationAnn]
resolveRef' x :: (ModuleName, DeclarationRef)
x@(ModuleName
mn, DeclarationRef
r) = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ModuleName
mn ModuleMap [IdeDeclarationAnn]
modules of
Maybe [IdeDeclarationAnn]
Nothing -> forall a b. a -> Either a b
Left (ModuleName, DeclarationRef)
x
Just [IdeDeclarationAnn]
decls' ->
let
setExportedFrom :: ModuleName -> IdeDeclarationAnn -> IdeDeclarationAnn
setExportedFrom = forall s t a b. ASetter s t a b -> b -> s -> t
set (Lens' IdeDeclarationAnn Annotation
idaAnnotation forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Annotation (Maybe ModuleName)
annExportedFrom) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
in
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (ModuleName
mn,) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (ModuleName -> IdeDeclarationAnn -> IdeDeclarationAnn
setExportedFrom ModuleName
mn)) ([IdeDeclarationAnn]
-> DeclarationRef -> Either DeclarationRef [IdeDeclarationAnn]
resolveRef [IdeDeclarationAnn]
decls' DeclarationRef
r)
resolveRef
:: [IdeDeclarationAnn]
-> P.DeclarationRef
-> Either P.DeclarationRef [IdeDeclarationAnn]
resolveRef :: [IdeDeclarationAnn]
-> DeclarationRef -> Either DeclarationRef [IdeDeclarationAnn]
resolveRef [IdeDeclarationAnn]
decls DeclarationRef
ref = case DeclarationRef
ref of
P.TypeRef SourceSpan
_ ProperName 'TypeName
tn Maybe [ProperName 'ConstructorName]
mdtors ->
case (IdeDeclaration -> Bool) -> Maybe IdeDeclarationAnn
findRef (forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf (Traversal' IdeDeclaration IdeType
_IdeDeclType forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' IdeType (ProperName 'TypeName)
ideTypeName) (forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
tn))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (IdeDeclaration -> Bool) -> Maybe IdeDeclarationAnn
findRef (forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf (Traversal' IdeDeclaration IdeTypeSynonym
_IdeDeclTypeSynonym forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' IdeTypeSynonym (ProperName 'TypeName)
ideSynonymName) (forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
tn)) of
Maybe IdeDeclarationAnn
Nothing ->
forall a b. a -> Either a b
Left DeclarationRef
ref
Just IdeDeclarationAnn
d -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ IdeDeclarationAnn
d forall a. a -> [a] -> [a]
: case Maybe [ProperName 'ConstructorName]
mdtors of
Maybe [ProperName 'ConstructorName]
Nothing ->
ProperName 'TypeName -> [IdeDeclarationAnn]
findDtors ProperName 'TypeName
tn
Just [ProperName 'ConstructorName]
dtors -> forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ProperName 'ConstructorName -> Maybe IdeDeclarationAnn
lookupDtor [ProperName 'ConstructorName]
dtors
P.ValueRef SourceSpan
_ Ident
i ->
(IdeDeclaration -> Bool)
-> Either DeclarationRef [IdeDeclarationAnn]
findWrapped (forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf (Traversal' IdeDeclaration IdeValue
_IdeDeclValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' IdeValue Ident
ideValueIdent) (forall a. Eq a => a -> a -> Bool
== Ident
i))
P.ValueOpRef SourceSpan
_ OpName 'ValueOpName
name ->
(IdeDeclaration -> Bool)
-> Either DeclarationRef [IdeDeclarationAnn]
findWrapped (forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf (Traversal' IdeDeclaration IdeValueOperator
_IdeDeclValueOperator forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' IdeValueOperator (OpName 'ValueOpName)
ideValueOpName) (forall a. Eq a => a -> a -> Bool
== OpName 'ValueOpName
name))
P.TypeOpRef SourceSpan
_ OpName 'TypeOpName
name ->
(IdeDeclaration -> Bool)
-> Either DeclarationRef [IdeDeclarationAnn]
findWrapped (forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf (Traversal' IdeDeclaration IdeTypeOperator
_IdeDeclTypeOperator forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' IdeTypeOperator (OpName 'TypeOpName)
ideTypeOpName) (forall a. Eq a => a -> a -> Bool
== OpName 'TypeOpName
name))
P.TypeClassRef SourceSpan
_ ProperName 'ClassName
name ->
(IdeDeclaration -> Bool)
-> Either DeclarationRef [IdeDeclarationAnn]
findWrapped (forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf (Traversal' IdeDeclaration IdeTypeClass
_IdeDeclTypeClass forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' IdeTypeClass (ProperName 'ClassName)
ideTCName) (forall a. Eq a => a -> a -> Bool
== ProperName 'ClassName
name))
DeclarationRef
_ ->
forall a b. a -> Either a b
Left DeclarationRef
ref
where
findWrapped :: (IdeDeclaration -> Bool)
-> Either DeclarationRef [IdeDeclarationAnn]
findWrapped = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left DeclarationRef
ref) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdeDeclaration -> Bool) -> Maybe IdeDeclarationAnn
findRef
findRef :: (IdeDeclaration -> Bool) -> Maybe IdeDeclarationAnn
findRef IdeDeclaration -> Bool
f = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (IdeDeclaration -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeDeclarationAnn -> IdeDeclaration
discardAnn) [IdeDeclarationAnn]
decls
lookupDtor :: ProperName 'ConstructorName -> Maybe IdeDeclarationAnn
lookupDtor ProperName 'ConstructorName
name =
(IdeDeclaration -> Bool) -> Maybe IdeDeclarationAnn
findRef (forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf (Traversal' IdeDeclaration IdeDataConstructor
_IdeDeclDataConstructor forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' IdeDataConstructor (ProperName 'ConstructorName)
ideDtorName) (forall a. Eq a => a -> a -> Bool
== ProperName 'ConstructorName
name))
findDtors :: ProperName 'TypeName -> [IdeDeclarationAnn]
findDtors ProperName 'TypeName
tn = forall a. (a -> Bool) -> [a] -> [a]
filter (forall s a. Getting Any s a -> (a -> Bool) -> s -> Bool
anyOf
(Lens' IdeDeclarationAnn IdeDeclaration
idaDeclaration
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversal' IdeDeclaration IdeDataConstructor
_IdeDeclDataConstructor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' IdeDataConstructor (ProperName 'TypeName)
ideDtorTypeName) (forall a. Eq a => a -> a -> Bool
== ProperName 'TypeName
tn)) [IdeDeclarationAnn]
decls