module Language.PureScript.Linter.Wildcards
  ( ignoreWildcardsUnderCompleteTypeSignatures
  ) where

import Protolude hiding (Type)

import Language.PureScript.AST
import Language.PureScript.Types

-- |
-- Replaces `TypeWildcard _ UnnamedWildcard` with
-- `TypeWildcard _ IgnoredWildcard` in places where we don't want to emit a
-- warning about wildcards.
--
-- The guiding principle here is that a wildcard can be ignored if there is a
-- complete (wildcard-free) type signature on a binding somewhere between the
-- type in which the wildcard occurs and the top level of the module. In
-- particular, this means that top-level signatures containing wildcards are
-- always warnings, and a top-level signature always prevents wildcards on
-- inner bindings from emitting warnings.
--
ignoreWildcardsUnderCompleteTypeSignatures :: Declaration -> Declaration
ignoreWildcardsUnderCompleteTypeSignatures :: Declaration -> Declaration
ignoreWildcardsUnderCompleteTypeSignatures = Declaration -> Declaration
onDecl
  where
  (Declaration -> Declaration
onDecl, Expr -> Expr
_, Binder -> Binder
_, CaseAlternative -> CaseAlternative
_, DoNotationElement -> DoNotationElement
_, Guard -> Guard
_) = forall s.
s
-> (s -> Declaration -> (s, Declaration))
-> (s -> Expr -> (s, Expr))
-> (s -> Binder -> (s, Binder))
-> (s -> CaseAlternative -> (s, CaseAlternative))
-> (s -> DoNotationElement -> (s, DoNotationElement))
-> (s -> Guard -> (s, Guard))
-> (Declaration -> Declaration, Expr -> Expr, Binder -> Binder,
    CaseAlternative -> CaseAlternative,
    DoNotationElement -> DoNotationElement, Guard -> Guard)
everywhereWithContextOnValues Bool
False (,) Bool -> Expr -> (Bool, Expr)
handleExpr Bool -> Binder -> (Bool, Binder)
handleBinder (,) (,) (,)

  handleExpr :: Bool -> Expr -> (Bool, Expr)
handleExpr Bool
isCovered = \case
    tv :: Expr
tv@(TypedValue Bool
chk Expr
v SourceType
ty)
      | Bool
isCovered -> (Bool
True, Bool -> Expr -> SourceType -> Expr
TypedValue Bool
chk Expr
v forall a b. (a -> b) -> a -> b
$ forall a. Type a -> Type a
ignoreWildcards SourceType
ty)
      | Bool
otherwise -> (forall a. Type a -> Bool
isComplete SourceType
ty, Expr
tv)
    Expr
other -> (Bool
isCovered, Expr
other)

  handleBinder :: Bool -> Binder -> (Bool, Binder)
handleBinder Bool
isCovered = \case
    tb :: Binder
tb@(TypedBinder SourceType
ty Binder
b)
      | Bool
isCovered -> (Bool
True, SourceType -> Binder -> Binder
TypedBinder (forall a. Type a -> Type a
ignoreWildcards SourceType
ty) Binder
b)
      | Bool
otherwise -> (forall a. Type a -> Bool
isComplete SourceType
ty, Binder
tb)
    Binder
other -> (Bool
isCovered, Binder
other)

ignoreWildcards :: Type a -> Type a
ignoreWildcards :: forall a. Type a -> Type a
ignoreWildcards = forall a. (Type a -> Type a) -> Type a -> Type a
everywhereOnTypes forall a b. (a -> b) -> a -> b
$ \case
  TypeWildcard a
a WildcardData
UnnamedWildcard -> forall a. a -> WildcardData -> Type a
TypeWildcard a
a WildcardData
IgnoredWildcard
  Type a
other -> Type a
other

isComplete :: Type a -> Bool
isComplete :: forall a. Type a -> Bool
isComplete = forall r a. (r -> r -> r) -> (Type a -> r) -> Type a -> r
everythingOnTypes Bool -> Bool -> Bool
(&&) forall a b. (a -> b) -> a -> b
$ \case
  TypeWildcard{} -> Bool
False
  Type a
_ -> Bool
True