module Language.PureScript.Sugar.Names.Common (warnDuplicateRefs) where
import Prelude
import Protolude (ordNub)
import Control.Monad.Writer (MonadWriter(..))
import Data.Foldable (for_)
import Data.List (group, sort, (\\))
import Data.Maybe (mapMaybe)
import Language.PureScript.AST (DeclarationRef(..), SourceSpan)
import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage, errorMessage, warnWithPosition)
import Language.PureScript.Names (Name(..))
warnDuplicateRefs
:: MonadWriter MultipleErrors m
=> SourceSpan
-> (Name -> SimpleErrorMessage)
-> [DeclarationRef]
-> m ()
warnDuplicateRefs :: forall (m :: * -> *).
MonadWriter MultipleErrors m =>
SourceSpan
-> (Name -> SimpleErrorMessage) -> [DeclarationRef] -> m ()
warnDuplicateRefs SourceSpan
pos Name -> SimpleErrorMessage
toError [DeclarationRef]
refs = do
let withoutCtors :: [DeclarationRef]
withoutCtors = DeclarationRef -> DeclarationRef
deleteCtors forall a b. (a -> b) -> [a] -> [b]
`map` [DeclarationRef]
refs
dupeRefs :: [(SourceSpan, Name)]
dupeRefs = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SourceSpan -> DeclarationRef -> Maybe (SourceSpan, Name)
refToName SourceSpan
pos) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
removeUnique [DeclarationRef]
withoutCtors
dupeCtors :: [(SourceSpan, Name)]
dupeCtors = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (SourceSpan -> DeclarationRef -> Maybe [(SourceSpan, Name)]
extractCtors SourceSpan
pos) [DeclarationRef]
refs
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([(SourceSpan, Name)]
dupeRefs forall a. [a] -> [a] -> [a]
++ [(SourceSpan, Name)]
dupeCtors) forall a b. (a -> b) -> a -> b
$ \(SourceSpan
pos', Name
name) ->
forall (m :: * -> *) a.
MonadWriter MultipleErrors m =>
SourceSpan -> m a -> m a
warnWithPosition SourceSpan
pos' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleErrorMessage -> MultipleErrors
errorMessage forall a b. (a -> b) -> a -> b
$ Name -> SimpleErrorMessage
toError Name
name
where
removeUnique :: Ord a => [a] -> [a]
removeUnique :: forall a. Ord a => [a] -> [a]
removeUnique = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> [a] -> [a]
drop Int
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
group forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
deleteCtors :: DeclarationRef -> DeclarationRef
deleteCtors :: DeclarationRef -> DeclarationRef
deleteCtors (TypeRef SourceSpan
sa ProperName 'TypeName
pn Maybe [ProperName 'ConstructorName]
_) = SourceSpan
-> ProperName 'TypeName
-> Maybe [ProperName 'ConstructorName]
-> DeclarationRef
TypeRef SourceSpan
sa ProperName 'TypeName
pn forall a. Maybe a
Nothing
deleteCtors DeclarationRef
other = DeclarationRef
other
extractCtors :: SourceSpan -> DeclarationRef -> Maybe [(SourceSpan, Name)]
extractCtors :: SourceSpan -> DeclarationRef -> Maybe [(SourceSpan, Name)]
extractCtors SourceSpan
pos' (TypeRef SourceSpan
_ ProperName 'TypeName
_ (Just [ProperName 'ConstructorName]
dctors)) =
let dupes :: [ProperName 'ConstructorName]
dupes = [ProperName 'ConstructorName]
dctors forall a. Eq a => [a] -> [a] -> [a]
\\ forall a. Ord a => [a] -> [a]
ordNub [ProperName 'ConstructorName]
dctors
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ProperName 'ConstructorName]
dupes then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (SourceSpan
pos',) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProperName 'ConstructorName -> Name
DctorName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ProperName 'ConstructorName]
dupes
extractCtors SourceSpan
_ DeclarationRef
_ = forall a. Maybe a
Nothing
refToName :: SourceSpan -> DeclarationRef -> Maybe (SourceSpan, Name)
refToName :: SourceSpan -> DeclarationRef -> Maybe (SourceSpan, Name)
refToName SourceSpan
pos' (TypeRef SourceSpan
_ ProperName 'TypeName
name Maybe [ProperName 'ConstructorName]
_) = forall a. a -> Maybe a
Just (SourceSpan
pos', ProperName 'TypeName -> Name
TyName ProperName 'TypeName
name)
refToName SourceSpan
pos' (TypeOpRef SourceSpan
_ OpName 'TypeOpName
op) = forall a. a -> Maybe a
Just (SourceSpan
pos', OpName 'TypeOpName -> Name
TyOpName OpName 'TypeOpName
op)
refToName SourceSpan
pos' (ValueRef SourceSpan
_ Ident
name) = forall a. a -> Maybe a
Just (SourceSpan
pos', Ident -> Name
IdentName Ident
name)
refToName SourceSpan
pos' (ValueOpRef SourceSpan
_ OpName 'ValueOpName
op) = forall a. a -> Maybe a
Just (SourceSpan
pos', OpName 'ValueOpName -> Name
ValOpName OpName 'ValueOpName
op)
refToName SourceSpan
pos' (TypeClassRef SourceSpan
_ ProperName 'ClassName
name) = forall a. a -> Maybe a
Just (SourceSpan
pos', ProperName 'ClassName -> Name
TyClassName ProperName 'ClassName
name)
refToName SourceSpan
pos' (ModuleRef SourceSpan
_ ModuleName
name) = forall a. a -> Maybe a
Just (SourceSpan
pos', ModuleName -> Name
ModName ModuleName
name)
refToName SourceSpan
_ DeclarationRef
_ = forall a. Maybe a
Nothing