{-# LANGUAGE BangPatterns #-}

-- |
-- Simple dead call elimination in foreign modules.
module Language.PureScript.DCE.Foreign 
  ( dceForeignModule ) where

import           Prelude.Compat
import           Control.Monad
import           Data.Graph
import           Data.Foldable (foldr')
import           Data.List (any, elem, filter)
import           Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import           Data.Text (Text)
import qualified Data.Text as T
import           Language.JavaScript.Parser.AST
                  ( JSStatement(..)
                  , JSExpression(..)
                  , JSCommaList(..)
                  , JSBlock(..)
                  , JSSwitchParts(..)
                  , JSTryCatch(..)
                  , JSTryFinally(..)
                  , JSArrayElement(..)
                  , JSObjectProperty(..)
                  , JSCommaTrailingList(..)
                  , JSCommaList(..)
                  )
import           Language.PureScript.Names

-- | foldr over `JSCommaList`
foldrJSCommaList :: (a -> b -> b) -> JSCommaList a -> b -> b
foldrJSCommaList _ JSLNil b = b
foldrJSCommaList fn (JSLOne a) !b = fn a b
foldrJSCommaList fn (JSLCons as _ a) !b = foldrJSCommaList fn as (fn a b)

-- |
-- Filter export statements in a foreign module.  This is not 100% safe.  It
-- might remove declarations that are used somewhere in the foreign module (for
-- example by using @'eval'@).
dceForeignModule :: [Ident] -> [JSStatement] -> [JSStatement]
dceForeignModule is stmts = filter filterExports stmts

  where
  filterExports :: JSStatement -> Bool
  filterExports (JSAssignStatement (JSMemberSquare (JSIdentifier _ "exports") _ (JSStringLiteral _ x) _) _ _ _)
    = fltr (unquote . T.pack $ x)
  filterExports (JSAssignStatement (JSMemberDot (JSIdentifier _ "exports") _ (JSIdentifier _ x)) _ _ _)
    = fltr (T.pack x)
  filterExports _ = True

  fltr :: Text -> Bool
  fltr t = any (fromMaybe True . (path graph <$> vertexForKey t <*>) . Just) entryPointVertices
        -- one of `entryPointVertices` depend on this vertex
        || any (isUsedInStmt t) nonExps
        -- it is used in any non export statements

  -- Build a graph of exports statements.  Its initial set of edges point from
  -- an export statement to all other export statements that are using it.
  -- When checking if we need to include that vartex we just check if there is
  -- a path from a vertex to one of `entryPointVertices`.
  exps :: [JSStatement]
  exps = filter isExportStatement stmts

  nonExps = filter (not . isExportStatement) stmts

  (graph, _, vertexForKey) = graphFromEdges verts

  verts :: [(JSStatement, Text, [Text])]
  verts = mapMaybe toVert exps
    where
    toVert :: JSStatement -> Maybe (JSStatement, Text, [Text])
    toVert s
      | Just name <- exportStatementName s = Just (s, name, foldr' (fn name) [] exps)
      | otherwise = Nothing

    fn name s' nms
      | isUsedInStmt name s'
      , Just n <- exportStatementName s' = n:nms
      | otherwise = nms

  entryPointVertices :: [Vertex]
  entryPointVertices = catMaybes $ do
    (_, k, _) <- verts
    guard $ k `elem` ns
    return (vertexForKey k)
    where
    ns = runIdent <$> is

  unquote :: Text -> Text
  unquote = T.drop 1 . T.dropEnd 1

  isExportStatement :: JSStatement -> Bool
  isExportStatement (JSAssignStatement (JSMemberDot (JSIdentifier _ "exports") _ (JSIdentifier _ _)) _ _ _) = True
  isExportStatement (JSAssignStatement (JSMemberSquare (JSIdentifier _ "exports") _ (JSStringLiteral _ _) _) _ _ _) = True
  isExportStatement _ = False

  exportStatementName :: JSStatement -> Maybe Text
  exportStatementName (JSAssignStatement (JSMemberDot (JSIdentifier _ "exports") _ (JSIdentifier _ i)) _ _ _) = Just . T.pack $ i
  exportStatementName (JSAssignStatement (JSMemberSquare (JSIdentifier _ "exports") _ (JSStringLiteral _ i) _) _ _ _) = Just . unquote . T.pack $ i
  exportStatementName _ = Nothing

  -- Check if (export) identifier is used within a JSStatement.
  isUsedInStmt :: Text -> JSStatement -> Bool
  isUsedInStmt n (JSStatementBlock _ ss _ _) = any (isUsedInStmt n) ss
  isUsedInStmt n (JSDoWhile _ stm _ _ e _ _) = isUsedInStmt n stm || isUsedInExpr n e
  isUsedInStmt n (JSFor _ _ es1 _ es2 _ es3 _ s) = isUsedInExprs n es1 || isUsedInExprs n es2 || isUsedInExprs n es3 || isUsedInStmt n s
  isUsedInStmt n (JSForIn _ _ e1 _ e2 _ s) = isUsedInExpr n e1 || isUsedInExpr n e2 || isUsedInStmt n s
  isUsedInStmt n (JSForVar _ _ _ es1 _ es2 _ es3 _ s) = isUsedInExprs n es1 || isUsedInExprs n es2 || isUsedInExprs n es3 || isUsedInStmt n s
  isUsedInStmt n (JSForVarIn _ _ _ e1 _ e2 _ s) = isUsedInExpr n e1 || isUsedInExpr n e2 || isUsedInStmt n s
  isUsedInStmt n (JSFunction _ _ _ _ _ (JSBlock _ ss _) _) = any (isUsedInStmt n) ss
  isUsedInStmt n (JSIf _ _ e _ s) = isUsedInExpr n e || isUsedInStmt n s
  isUsedInStmt n (JSIfElse _ _ e _ s1 _ s2) = isUsedInExpr n e || isUsedInStmt n s1 || isUsedInStmt n s2
  isUsedInStmt n (JSLabelled _ _ s) = isUsedInStmt n s
  isUsedInStmt _ (JSEmptyStatement _) = False
  isUsedInStmt n (JSExpressionStatement e _) = isUsedInExpr n e
  isUsedInStmt n (JSAssignStatement e1 _ e2 _) = isUsedInExpr n e1 || isUsedInExpr n e2
  isUsedInStmt n (JSMethodCall e _ es _ _) = isUsedInExpr n e || isUsedInExprs n es
  isUsedInStmt n (JSReturn _ me _) = fromMaybe False (isUsedInExpr n <$> me)
  isUsedInStmt n (JSSwitch _ _ e _ _ sps _ _) = isUsedInExpr n e || any (isUsedInSwitchParts n) sps
  isUsedInStmt n (JSThrow _ e _) = isUsedInExpr n e
  isUsedInStmt n (JSTry _ (JSBlock _ ss _) cs f) = any (isUsedInStmt n) ss || any (isUsedInTryCatch n) cs || isUsedInFinally n f
  isUsedInStmt n (JSVariable _ es _) = isUsedInExprs n es
  isUsedInStmt n (JSWhile _ _ e _ s) = isUsedInExpr n e || isUsedInStmt n s
  isUsedInStmt n (JSWith _ _ e _ s _) = isUsedInExpr n e || isUsedInStmt n s
  isUsedInStmt _ JSBreak{} = False
  isUsedInStmt _ JSConstant{} = False
  isUsedInStmt _ JSContinue{} = False

  -- Check is (export) identifier is used withing a JSExpression
  isUsedInExpr :: Text -> JSExpression -> Bool
  isUsedInExpr n (JSMemberDot (JSIdentifier _ "exports") _ (JSIdentifier _ i)) = n == T.pack i
  isUsedInExpr n (JSMemberDot e1 _ e2) = isUsedInExpr n e1 || isUsedInExpr n e2
  isUsedInExpr n (JSArrayLiteral _ as _) = any (isUsedInArrayElement n) as
  isUsedInExpr n (JSAssignExpression e1 _ e2) = isUsedInExpr n e1 || isUsedInExpr n e2
  isUsedInExpr n (JSCallExpression e _ es _) = isUsedInExpr n e || isUsedInExprs n es
  isUsedInExpr n (JSCallExpressionDot e1 _ e2) = isUsedInExpr n e1 || isUsedInExpr n e2
  isUsedInExpr n (JSCallExpressionSquare e1 _ e2 _) = isUsedInExpr n e1 || isUsedInExpr n e2
  isUsedInExpr n (JSExpressionBinary e1 _ e2) = isUsedInExpr n e1 || isUsedInExpr n e2
  isUsedInExpr n (JSExpressionParen _ e _) = isUsedInExpr n e
  isUsedInExpr n (JSExpressionPostfix e _) = isUsedInExpr n e
  isUsedInExpr n (JSExpressionTernary e1 _ e2 _ e3) = isUsedInExpr n e1 || isUsedInExpr n e2 || isUsedInExpr n e3
  isUsedInExpr n (JSFunctionExpression _ _ _ _ _ (JSBlock _ ss _)) = any (isUsedInStmt n) ss
  isUsedInExpr n (JSMemberExpression e _ es _) = isUsedInExpr n e || isUsedInExprs n es
  isUsedInExpr n (JSMemberNew _ e _ es _) = isUsedInExpr n e || isUsedInExprs n es
  isUsedInExpr n (JSMemberSquare (JSIdentifier _ "exports") _ (JSStringLiteral _ i) _) = n == (unquote .T.pack $ i)
  isUsedInExpr n (JSMemberSquare e1 _ e2 _) = isUsedInExpr n e1 || isUsedInExpr n e2
  isUsedInExpr n (JSNewExpression _ e) = isUsedInExpr n e
  isUsedInExpr n (JSObjectLiteral _ ops _) = foldrJSCommaList (\p b -> isUsedInObjectProperty n p || b) (fromCTList ops) False
    where
    fromCTList (JSCTLComma as _) = as
    fromCTList (JSCTLNone as) = as
  isUsedInExpr n (JSUnaryExpression _ e) = isUsedInExpr n e
  isUsedInExpr n (JSVarInitExpression e _) = isUsedInExpr n e
  isUsedInExpr _ JSIdentifier{} = False
  isUsedInExpr _ JSDecimal{} = False
  isUsedInExpr _ JSLiteral{} = False
  isUsedInExpr _ JSHexInteger{} = False
  isUsedInExpr _ JSOctal{} = False
  isUsedInExpr _ JSStringLiteral{} = False
  isUsedInExpr _ JSRegEx{} = False
  isUsedInExpr n (JSCommaExpression e1 _ e2) = isUsedInExpr n e1 || isUsedInExpr n e2

  isUsedInExprs :: Text -> JSCommaList JSExpression -> Bool
  isUsedInExprs n es = foldrJSCommaList fn es False
    where
    fn :: JSExpression -> Bool -> Bool
    fn e b = isUsedInExpr n e || b

  -- Check if (export) identifier is used withing a JSSitchParts
  isUsedInSwitchParts :: Text -> JSSwitchParts -> Bool
  isUsedInSwitchParts n (JSCase _ e _ ss) = isUsedInExpr n e || any (isUsedInStmt n) ss
  isUsedInSwitchParts n (JSDefault _ _ ss) = any (isUsedInStmt n) ss

  -- Check if (export) identifier is used withing a JSTryCatch
  isUsedInTryCatch :: Text -> JSTryCatch -> Bool
  isUsedInTryCatch n (JSCatch _ _ e _ (JSBlock _ ss _)) = isUsedInExpr n e || any (isUsedInStmt n) ss
  isUsedInTryCatch n (JSCatchIf _ _ e1 _ e2 _ (JSBlock _ ss _)) = isUsedInExpr n e1 || isUsedInExpr n e2 || any (isUsedInStmt n) ss

  -- |
  -- Check if (export) identifier is used withing a JSTryFinally
  isUsedInFinally :: Text -> JSTryFinally -> Bool
  isUsedInFinally n (JSFinally _ (JSBlock _ ss _)) = any (isUsedInStmt n) ss
  isUsedInFinally _ JSNoFinally = False

  -- |
  -- Check if (export) identifier is used withing a JSArrayElement
  isUsedInArrayElement :: Text -> JSArrayElement -> Bool
  isUsedInArrayElement n (JSArrayElement e) = isUsedInExpr n e
  isUsedInArrayElement _ JSArrayComma{} = False

  -- |
  -- Check if (export) identifier is used withing a JSObjectProperty
  isUsedInObjectProperty :: Text -> JSObjectProperty -> Bool
  isUsedInObjectProperty n (JSPropertyAccessor _ _ _ es _ (JSBlock _ ss _)) = any (isUsedInExpr n) es || any (isUsedInStmt n) ss
  isUsedInObjectProperty n (JSPropertyNameandValue _ _ es) = any (isUsedInExpr n) es