    {-# LANGUAGE FlexibleContexts  #-}
    {-# LANGUAGE FlexibleInstances #-}

    -- TODO:
    -- ! User configuration.
    -- ! Checking for side-effect-less code, e.g. "1;".

    module Yi.Verifier.JavaScript where

    import           Control.Monad             (unless)
    import           Control.Monad.Writer.Lazy (MonadWriter, Writer, tell)
    import qualified Data.DList                as D (DList, singleton)
    import           Data.Foldable             (toList)
    import           Data.Function             (on)
    import           Data.List                 (intercalate)
    import           Yi.Lexer.Alex             (Posn, Tok, tokPosn, tokT)
    import           Yi.Lexer.JavaScript       (TT, Token (..))
    import           Yi.Syntax.JavaScript      hiding (res)

    -- * Types

    data Error = MultipleFunctionDeclaration String [Posn]
                 deriving Error -> Error -> Bool
    (Error -> Error -> Bool) -> (Error -> Error -> Bool) -> Eq Error
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Error -> Error -> Bool
    == :: Error -> Error -> Bool
    $c/= :: Error -> Error -> Bool
    /= :: Error -> Error -> Bool
    Eq

    data Warning = UnreachableCode Posn
                   deriving Warning -> Warning -> Bool
    (Warning -> Warning -> Bool)
    -> (Warning -> Warning -> Bool) -> Eq Warning
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Warning -> Warning -> Bool
    == :: Warning -> Warning -> Bool
    $c/= :: Warning -> Warning -> Bool
    /= :: Warning -> Warning -> Bool
    Eq

    data Report = Err  Error
                | Warn Warning
                  deriving Report -> Report -> Bool
    (Report -> Report -> Bool)
    -> (Report -> Report -> Bool) -> Eq Report
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Report -> Report -> Bool
    == :: Report -> Report -> Bool
    $c/= :: Report -> Report -> Bool
    /= :: Report -> Report -> Bool
    Eq

    -- * Instances

    instance Show Error where
        show :: Error -> String
    show (MultipleFunctionDeclaration String
    n [Posn]
    ps) =
            String
    "Function `" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "' declared more than once: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " ((Posn -> String) -> [Posn] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Posn -> String
    forall a. Show a => a -> String
    show [Posn]
    ps)

    instance Show Warning where
        show :: Warning -> String
    show (UnreachableCode Posn
    pos) =
            String
    "Unreachable code at " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Posn -> String
    forall a. Show a => a -> String
    show Posn
    pos

    instance Show Report where
        show :: Report -> String
    show (Err Error
    e) = String
    "EE " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Error -> String
    forall a. Show a => a -> String
    show Error
    e
        show (Warn Warning
    w) = String
    "WW " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Warning -> String
    forall a. Show a => a -> String
    show Warning
    w

    -- * Main code

    -- | The main verifier which calls the sub-verifiers.
    verify :: Tree TT -> Writer (D.DList Report) ()
    verify :: Tree TT -> Writer (DList Report) ()
    verify Tree TT
    t = do
      let topfuns :: Tree TT
    topfuns = Tree TT -> Tree TT
    forall t. [Statement t] -> [Statement t]
    findFunctions (Tree TT -> Tree TT
    forall a. [a] -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList Tree TT
    t)
      Tree TT -> Writer (DList Report) ()
    checkMultipleFuns Tree TT
    topfuns
      (Statement TT -> Writer (DList Report) ())
    -> Tree TT -> Writer (DList Report) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Tree TT -> Writer (DList Report) ()
    checkUnreachable (Tree TT -> Writer (DList Report) ())
    -> (Statement TT -> Tree TT)
    -> Statement TT
    -> Writer (DList Report) ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Statement TT -> Tree TT
    forall t. Statement t -> [Statement t]
    funBody) Tree TT
    topfuns

    -- | Given a list of function declarations, checks for multiple function
    --   declarations, including the functions' subfunctions.
    checkMultipleFuns :: [Statement TT] -> Writer (D.DList Report) ()
    checkMultipleFuns :: Tree TT -> Writer (DList Report) ()
    checkMultipleFuns Tree TT
    stmts = do
      let dupFuns :: Tree TT
    dupFuns = (Statement TT -> Statement TT -> Bool) -> Tree TT -> Tree TT
    forall a. (a -> a -> Bool) -> [a] -> [a]
    dupsBy (TT -> TT -> Bool
    forall t. Eq t => Tok t -> Tok t -> Bool
    ttEq (TT -> TT -> Bool)
    -> (Statement TT -> TT) -> Statement TT -> Statement TT -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` Statement TT -> TT
    forall t. Statement t -> t
    funName) Tree TT
    stmts
      Bool -> Writer (DList Report) () -> Writer (DList Report) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Tree TT -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Tree TT
    dupFuns)
        (Report -> Writer (DList Report) ()
    forall a (m :: * -> *). MonadWriter (DList a) m => a -> m ()
    say (Error -> Report
    Err (String -> [Posn] -> Error
    MultipleFunctionDeclaration
                   (Token -> String
    nameOf (Token -> String) -> Token -> String
    forall a b. (a -> b) -> a -> b
    $ TT -> Token
    forall t. Tok t -> t
    tokT (TT -> Token) -> TT -> Token
    forall a b. (a -> b) -> a -> b
    $ Statement TT -> TT
    forall t. Statement t -> t
    funName (Statement TT -> TT) -> Statement TT -> TT
    forall a b. (a -> b) -> a -> b
    $ Tree TT -> Statement TT
    forall a. HasCallStack => [a] -> a
    head Tree TT
    dupFuns)
                   ((Statement TT -> Posn) -> Tree TT -> [Posn]
    forall a b. (a -> b) -> [a] -> [b]
    map (TT -> Posn
    forall t. Tok t -> Posn
    tokPosn (TT -> Posn) -> (Statement TT -> TT) -> Statement TT -> Posn
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Statement TT -> TT
    forall t. Statement t -> t
    funName) Tree TT
    dupFuns))))
      let subFuns :: [Tree TT]
    subFuns = (Statement TT -> Tree TT) -> Tree TT -> [Tree TT]
    forall a b. (a -> b) -> [a] -> [b]
    map (Tree TT -> Tree TT
    forall t. [Statement t] -> [Statement t]
    findFunctions (Tree TT -> Tree TT)
    -> (Statement TT -> Tree TT) -> Statement TT -> Tree TT
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Statement TT -> Tree TT
    forall t. Statement t -> [Statement t]
    funBody) (Tree TT -> Tree TT
    forall t. [Statement t] -> [Statement t]
    findFunctions Tree TT
    stmts)
      (Tree TT -> Writer (DList Report) ())
    -> [Tree TT] -> Writer (DList Report) ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Tree TT -> Writer (DList Report) ()
    checkMultipleFuns [Tree TT]
    subFuns

    checkUnreachable :: [Statement TT] -> Writer (D.DList Report) ()
    checkUnreachable :: Tree TT -> Writer (DList Report) ()
    checkUnreachable Tree TT
    stmts = do
      let afterReturn :: Tree TT
    afterReturn = (Statement TT -> Bool) -> Tree TT -> Tree TT
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile' (Bool -> Bool
    not (Bool -> Bool) -> (Statement TT -> Bool) -> Statement TT -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Statement TT -> Bool
    forall t. Statement t -> Bool
    isReturn) Tree TT
    stmts
      Bool -> Writer (DList Report) () -> Writer (DList Report) ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Tree TT -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Tree TT
    afterReturn)
        (Report -> Writer (DList Report) ()
    forall a (m :: * -> *). MonadWriter (DList a) m => a -> m ()
    say (Warning -> Report
    Warn (Posn -> Warning
    UnreachableCode (TT -> Posn
    forall t. Tok t -> Posn
    tokPosn (TT -> Posn) -> TT -> Posn
    forall a b. (a -> b) -> a -> b
    $ Statement TT -> TT
    forall (f :: * -> *) t. Foldable f => f t -> t
    firstTok (Statement TT -> TT) -> Statement TT -> TT
    forall a b. (a -> b) -> a -> b
    $ Tree TT -> Statement TT
    forall a. HasCallStack => [a] -> a
    head Tree TT
    afterReturn))))

    -- * Helper functions

    -- | Given two @Tok t@, compares the @t@s.
    ttEq :: Eq t => Tok t -> Tok t -> Bool
    ttEq :: forall t. Eq t => Tok t -> Tok t -> Bool
    ttEq Tok t
    x Tok t
    y = Tok t -> t
    forall t. Tok t -> t
    tokT Tok t
    x t -> t -> Bool
    forall a. Eq a => a -> a -> Bool
    == Tok t -> t
    forall t. Tok t -> t
    tokT Tok t
    y

    say :: MonadWriter (D.DList a) m => a -> m ()
    say :: forall a (m :: * -> *). MonadWriter (DList a) m => a -> m ()
    say = DList a -> m ()
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
    tell (DList a -> m ()) -> (a -> DList a) -> a -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> DList a
    forall a. a -> DList a
    D.singleton

    isReturn :: Statement t -> Bool
    isReturn :: forall t. Statement t -> Bool
    isReturn (Return {}) = Bool
    True
    isReturn Statement t
    _           = Bool
    False

    -- | Returns a list of the functions in the given block.
    findFunctions :: [Statement t] -> [Statement t]
    findFunctions :: forall t. [Statement t] -> [Statement t]
    findFunctions [Statement t]
    stmts = [ Statement t
    f | f :: Statement t
    f@(FunDecl {}) <- [Statement t]
    stmts ]

    -- | Given a 'FunDecl', returns the token representing the name.
    funName :: Statement t -> t
    funName :: forall t. Statement t -> t
    funName (FunDecl t
    _ t
    n Parameters t
    _ Block t
    _) = t
    n
    funName Statement t
    _                 = t
    forall a. HasCallStack => a
    undefined

    -- | Given a 'FunDecl', returns its inner body as a list.
    funBody :: Statement t -> [Statement t]
    funBody :: forall t. Statement t -> [Statement t]
    funBody (FunDecl t
    _ t
    _ Parameters t
    _ Block t
    blk) =
        case Block t
    blk of
          Block t
    _ [Statement t]
    stmts t
    _ -> [Statement t] -> [Statement t]
    forall a. [a] -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList [Statement t]
    stmts
          BlockOne Statement t
    stmt   -> [Statement t
    stmt]
          Block t
    _               -> []
    funBody Statement t
    _ = [Statement t]
    forall a. HasCallStack => a
    undefined

    -- | Given a @ValidName@ returns the string representing the name.
    nameOf :: Token -> String
    nameOf :: Token -> String
    nameOf (ValidName String
    n) = String
    n
    nameOf Token
    _             = String
    forall a. HasCallStack => a
    undefined

    -- * Misc

    -- | Like 'dropWhile' but drops the first element in the result.
    dropWhile' :: (a -> Bool) -> [a] -> [a]
    dropWhile' :: forall a. (a -> Bool) -> [a] -> [a]
    dropWhile' a -> Bool
    p [a]
    xs =
        let res :: [a]
    res = (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile a -> Bool
    p [a]
    xs in
        if [a] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    res then [] else Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [a]
    res

    dupsBy :: (a -> a -> Bool) -> [a] -> [a]
    dupsBy :: forall a. (a -> a -> Bool) -> [a] -> [a]
    dupsBy a -> a -> Bool
    p [a]
    xs = (a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\a
    x -> [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ((a -> Bool) -> [a] -> [a]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (a -> a -> Bool
    p a
    x) [a]
    xs) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1) [a]
    xs