{-# LANGUAGE ViewPatterns #-}

module Language.Mulang.Inspector.Smell (
  discardsExceptions,
  doesConsolePrint,
  doesNilTest,
  doesTypeTest,
  hasAssignmentReturn,
  hasAssignmentCondition,
  hasEmptyIfBranches,
  hasEmptyRepeat,
  hasLongParameterList,
  hasRedundantBooleanComparison,
  hasRedundantGuards,
  hasRedundantIf,
  hasRedundantLambda,
  hasRedundantLocalVariableReturn,
  hasRedundantParameter,
  hasRedundantRepeat,
  hasTooManyMethods,
  hasEqualIfBranches,
  detectDeclarationTypos,
  detectUsageTypos,
  hasUnreachableCode,
  isLongCode,
  overridesEqualOrHashButNotBoth,
  returnsNil,
  usesNamedSelfReference,
  shouldInvertIfCondition,
  shouldUseOtherwise,
  shouldUseStrictComparators) where

import           Language.Mulang.Ast
import qualified Language.Mulang.Ast.Operator as O
import           Language.Mulang.Generator (Generator, identifierReferences, declaredIdentifiers, referencedIdentifiers, declarations)
import           Language.Mulang.Inspector.Primitive
import           Language.Mulang.Inspector.Query (inspect, select)

import           Data.Text.Metrics (damerauLevenshtein)
import           Data.Text (pack)

-- | Inspection that tells whether an expression has expressions like 'x == True'
hasRedundantBooleanComparison :: Inspection
hasRedundantBooleanComparison = compares isBooleanLiteral

hasRedundantRepeat :: Inspection
hasRedundantRepeat = containsExpression f
  where f (Repeat (MuNumber 1) _) = True
        f _                       = False

shouldUseStrictComparators :: Inspection
shouldUseStrictComparators = containsExpression f
  where f (Primitive O.Similar)    = True
        f (Primitive O.NotSimilar) = True
        f _                        = False

doesNilTest :: Inspection
doesNilTest = compares f
  where f MuNil = True
        f _     = False

doesTypeTest :: Inspection
doesTypeTest = compares f
  where f (MuString _) = True
        f _            = False

isLongCode :: Inspection
isLongCode = containsExpression f
  where f (Sequence xs)  = (length xs) >= 16
        f  _             = False

compares :: (Expression -> Bool) -> Inspection
compares f = containsExpression (any f.comparisonOperands)

comparisonOperands (Call (Primitive O.Like)        [a1, a2])   = [a1, a2]
comparisonOperands (Call (Primitive O.NotLike)     [a1, a2])   = [a1, a2]
comparisonOperands _                                           = []

returnsNil :: Inspection
returnsNil = containsExpression f
  where f (Return MuNil) = True
        f _              = False

hasEqualIfBranches :: Inspection
hasEqualIfBranches = containsExpression f
  where f (If _ None None) = False
        f (If _ t e)       = t == e
        f _                = False

-- | Inspection that tells whether an expression has an if expression where both branches return
-- boolean literals
hasRedundantIf :: Inspection
hasRedundantIf = containsExpression f
  where f (If _ (Assignment v1 x) (Assignment v2 y)) = all isBooleanLiteral [x, y] && v1 == v2
        f (If _ (Variable v1 x) (Variable v2 y))     = all isBooleanLiteral [x, y] && v1 == v2
        f (If _ (Return x) (Return y))               = all isBooleanLiteral [x, y]
        f (If _ (Yield x) (Yield y))                 = all isBooleanLiteral [x, y]
        f (If _ x y)                                 = all isBooleanLiteral [x, y]
        f (Sequence expressions)                     = containsUnstructuredBooleanReturn expressions
        f _                                          = False

        containsUnstructuredBooleanReturn (If _ (Return x) None:Return y:_) | all isBooleanLiteral [x, y] = True
        containsUnstructuredBooleanReturn (_:xs)                            = containsUnstructuredBooleanReturn xs
        containsUnstructuredBooleanReturn []                                = False

-- | Inspection that tells whether an expression has guards where both branches return
-- boolean literals
hasRedundantGuards :: Inspection
hasRedundantGuards = containsBody f -- TODO not true when condition is a pattern
  where f (GuardedBody [
            (_, Return x),
            (Primitive O.Otherwise, Return y)]) = all isBooleanLiteral [x, y]
        f _ = False

-- | Inspection that tells whether an expression has guards with a hardcoded false instead of an otherwise
shouldUseOtherwise :: Inspection
shouldUseOtherwise = containsBody f
  where f (GuardedBody (last -> (MuTrue, _))) = True
        f _                                   = False

-- | Inspection that tells whether an expression has lambda expressions like '\x -> g x'
hasRedundantLambda :: Inspection
hasRedundantLambda = containsExpression f
  where f (Lambda [VariablePattern (x)] (Return (Call _ [Reference (y)]))) = x == y
        f _ = False

-- | Inspection that tells whether an expression has parameters that
-- can be avoided using point-free
hasRedundantParameter :: Inspection
hasRedundantParameter = containsExpression f
  where f function@(SimpleFunction _ params (Return (Application _ args))) | Just (VariablePattern param) <- safeLast params,
                                                                             Just (Reference arg) <- safeLast args = param == arg && showsUpOnlyOnce param (identifierReferences function)
        f _ = False
        showsUpOnlyOnce p = (==1).countElem p
        countElem p = length.filter (==p)
        safeLast [] = Nothing
        safeLast l = Just $ last l

isBooleanLiteral (MuBool _) = True
isBooleanLiteral _          = False

hasRedundantLocalVariableReturn :: Inspection
hasRedundantLocalVariableReturn = containsExpression f
  where f (Sequence (reverse ->
                      (Return (Reference returnedVariable) :
                        Variable declaredVariable _:_))) = returnedVariable == declaredVariable
        f _                                              = False

hasAssignmentCondition :: Inspection
hasAssignmentCondition = containsExpression f
  where f (If (Unification _ _) _ _)  = True
        f (While (Unification _ _) _) = True
        f _                           = False

hasAssignmentReturn :: Inspection
hasAssignmentReturn = containsExpression f
  where f (Return (Unification _ _))   = True
        f _                         = False

discardsExceptions :: Inspection
discardsExceptions = containsExpression f
  where f (Try _ [(_, None)] _)  = True
        f (Try _ [(_, Print _)] _) = True
        f _                        = False

doesConsolePrint :: Inspection
doesConsolePrint = containsExpression f
  where f (Print _) = True
        f _         = False

hasLongParameterList :: Inspection
hasLongParameterList = containsExpression f
  where f (Params p) = (>4).length $ p
        f _ = False

hasTooManyMethods :: Inspection
hasTooManyMethods = containsExpression f
  where f (Sequence expressions) = (>15).length.filter isMethod $ expressions
        f _ = False

        isMethod (Method _ _) = True
        isMethod _ = False

overridesEqualOrHashButNotBoth :: Inspection
overridesEqualOrHashButNotBoth = containsExpression f
  where f (Sequence expressions) = (any isEqual expressions) /= (any isHash expressions)
        f (Class _ _ (PrimitiveMethod O.Like     _)) = True
        f (Class _ _ (PrimitiveMethod O.Hash _))     = True
        f _ = False

        isEqual (PrimitiveMethod O.Like     _) = True
        isEqual _ = False

        isHash (PrimitiveMethod O.Hash _) = True
        isHash _ = False

shouldInvertIfCondition :: Inspection
shouldInvertIfCondition = containsExpression f
  where f (If _ None elseBranch) = elseBranch /= None
        f _                        = False

hasEmptyIfBranches :: Inspection
hasEmptyIfBranches = containsExpression f
  where f (If _ None None) = True
        f _                = False

hasEmptyRepeat :: Inspection
hasEmptyRepeat = containsExpression f
  where f (Repeat _ None) = True
        f _               = False

hasUnreachableCode :: Inspection
hasUnreachableCode = containsExpression f
  where f (Subroutine _ equations) = any equationMatchesAnyValue . init $ equations
        f (Sequence expressions)   = hasCodeAfterReturn expressions
        f _                        = False

        equationMatchesAnyValue (Equation patterns body) = all patternMatchesAnyValue patterns && bodyMatchesAnyValue body

        patternMatchesAnyValue WildcardPattern     = True
        patternMatchesAnyValue (VariablePattern _) = True
        patternMatchesAnyValue _                   = False

        bodyMatchesAnyValue (UnguardedBody _)    = True
        bodyMatchesAnyValue (GuardedBody guards) = any (isTruthy . fst) guards

        isTruthy (MuBool True)           = True
        isTruthy (Primitive O.Otherwise) = True
        isTruthy _                       = False

        hasCodeAfterReturn []           = False
        hasCodeAfterReturn [_]          = False
        hasCodeAfterReturn (Return _:_) = True
        hasCodeAfterReturn (_:xs)       = hasCodeAfterReturn xs


detectDeclarationTypos :: Identifier -> Expression -> [Identifier]
detectDeclarationTypos = detectTypos declaredIdentifiers

detectUsageTypos :: Identifier -> Expression -> [Identifier]
detectUsageTypos = detectTypos referencedIdentifiers

detectTypos :: Generator Identifier -> Identifier -> Expression -> [Identifier]
detectTypos generator name expression | elem name identifiers = []
                                      | otherwise = filter (similar name) identifiers
  where
    identifiers  = generator expression
    similar one other = damerauLevenshtein (pack one) (pack other) == 1


usesNamedSelfReference :: Inspection
usesNamedSelfReference expression = inspect $ do
  Object name      objectBody <- declarations expression
  SimpleMethod _ _ methodBody <- topLevelExpressions objectBody
  select (elem name $ referencedIdentifiers methodBody)
    where topLevelExpressions (Sequence es) = es
          topLevelExpressions e             = [e]
