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
import Language.PureScript.Errors
import Language.PureScript.Names

-- |
-- Warns about duplicate values in a list of declaration refs.
--
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. (Eq 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

  -- Removes all unique elements from list
  -- as well as one of each duplicate.
  -- Example:
  --  removeUnique [1,2,2,3,3,3,4] == [2,3,3]
  -- Note that it may be more correct to keep ALL duplicates,
  -- but that requires additional changes in how warnings are printed.
  -- Example of keeping all duplicates (not what this code currently does):
  --  removeUnique [1,2,2,3,3,3,4] == [2,2,3,3,3]
  removeUnique :: Eq a => Ord a => [a] -> [a]
  removeUnique :: forall a. (Eq 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

  -- Deletes the constructor information from TypeRefs so that only the
  -- referenced type is used in the duplicate check - constructors are handled
  -- separately
  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

  -- Extracts the names of duplicate constructor references from TypeRefs.
  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

  -- Converts a DeclarationRef into a name for an error message.
  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