Generic.hs

module Language.Mulang.Inspector.Generic (
  parses,
  assigns,
  calls,
  uses,
  usesIf,
  usesYield,
  usesFor,
  declares,
  declaresVariable,
  declaresRecursively,
  declaresEntryPoint,
  declaresFunction,
  declaresComputation,
  declaresComputationWithArity,
  declaresComputationWithArity',
  usesAnonymousVariable,
  raises,
  rescues,
  usesExceptions,
  usesExceptionHandling) where

import Language.Mulang.Ast
import Language.Mulang.Identifier
import Language.Mulang.Inspector.Primitive
import Language.Mulang.Generator (declaredIdentifiers, referencedIdentifiers)

import Data.Maybe (listToMaybe)
import Data.List.Extra (has)


-- | Inspection that tells whether an expression is equal to a given piece of code after being parsed
parses :: (String -> Expression) -> String -> Inspection
parses parser code = (== (parser code))

assigns :: IdentifierInspection
assigns predicate = containsExpression f
  where f (Assignment name _)  = predicate name
        f (Variable name _)    = predicate name
        f (Attribute name _)   = predicate name
        f _                    = False

-- | Inspection that tells whether an expression uses the the given target identifier
-- in its definition
uses :: IdentifierInspection
uses p = containsExpression f
  where f = any p . referencedIdentifiers

calls :: IdentifierInspection
calls p = containsExpression f
  where f (Call (Reference id) _ ) = p id
        f _                        = False


-- | Inspection that tells whether an expression uses ifs
-- in its definition
usesIf :: Inspection
usesIf = containsExpression f
  where f (If _ _ _) = True
        f _          = False

usesYield :: Inspection
usesYield = containsExpression f
  where f (Yield _) = True
        f _         = False

usesFor :: Inspection
usesFor = containsExpression f
  where f (For _ _) = True
        f _         = False


-- | Inspection that tells whether a top level declaration exists
declares :: IdentifierInspection
declares = containsBoundDeclaration f
  where f (TypeSignature _ _) = False
        f _                   = True

-- | Inspection that tells whether an expression is direct recursive
declaresRecursively :: IdentifierInspection
declaresRecursively = containsBoundDeclaration f
  where f e | (Just name) <- (nameOf e) = uses (named name) e
            | otherwise = False

        nameOf :: Expression -> Maybe Identifier
        nameOf = listToMaybe . declaredIdentifiers


declaresFunction :: IdentifierInspection
declaresFunction = containsBoundDeclaration f
  where f (Function _ _) = True
        f _              = False

declaresVariable :: IdentifierInspection
declaresVariable = containsBoundDeclaration f
  where f (Variable _ _)  = True
        f _               = False

declaresEntryPoint :: IdentifierInspection
declaresEntryPoint = containsBoundDeclaration f
  where f (EntryPoint _ _)  = True
        f _                 = False

-- | Inspection that tells whether a top level computation declaration exists
declaresComputation :: IdentifierInspection
declaresComputation = declaresComputationWithArity' (const True)

declaresComputationWithArity :: Int -> IdentifierInspection
declaresComputationWithArity arity = declaresComputationWithArity' (== arity)

declaresComputationWithArity' :: (Int -> Bool) -> IdentifierInspection
declaresComputationWithArity' arityPredicate = containsBoundDeclaration f
  where f (Subroutine _ es)       = any equationArityIs es
        f (Clause _ args _)       = argsHaveArity args
        f _  = False

        equationArityIs (Equation args _) = argsHaveArity args

        argsHaveArity = arityPredicate.length

raises :: IdentifierInspection
raises predicate = containsExpression f
  where f (Raise (New (Reference n) _)) = predicate n
        f (Raise (Reference n))         = predicate n
        f _                             = False

usesExceptions :: Inspection
usesExceptions = containsExpression f
  where f (Raise _)     = True
        f _             = False

rescues :: IdentifierInspection
rescues predicate = containsExpression f
  where f (Try _ rescues _) = any (matchesType predicate) . map fst  $ rescues
        f _                 = False

usesExceptionHandling :: Inspection
usesExceptionHandling  = containsExpression f
  where f (Try _ _ _) = True
        f _           = False

usesAnonymousVariable :: Inspection
usesAnonymousVariable = containsExpression f
  where f (Subroutine _ body)    = equationContainsWildcard body
--TODO        f (Lambda args _)  = equationContainsWildcard equations
        f (Clause _ params _)    = any isOrContainsWildcard params
        f _                      = False

        equationContainsWildcard =  has isOrContainsWildcard subroutineBodyPatterns

        isOrContainsWildcard (InfixApplicationPattern p1 _ p2) = any isOrContainsWildcard [p1, p2]
        isOrContainsWildcard (ApplicationPattern _ ps)         = any isOrContainsWildcard ps
        isOrContainsWildcard (TuplePattern ps)                 = any isOrContainsWildcard ps
        isOrContainsWildcard (ListPattern ps)                  = any isOrContainsWildcard ps
        isOrContainsWildcard (FunctorPattern _ ps)             = any isOrContainsWildcard ps
        isOrContainsWildcard (AsPattern _ p)                   = isOrContainsWildcard p
        isOrContainsWildcard WildcardPattern                   = True
        isOrContainsWildcard _                                 = False