{-# language DataKinds, TypeOperators #-}
{-# language DeriveFunctor #-}
{-# language FlexibleContexts #-}
{-# language RankNTypes #-}
{-# language LambdaCase #-}
{-# language OverloadedLists #-}
{-# language ScopedTypeVariables, TypeApplications #-}
{-# language MultiParamTypeClasses #-}

{-|
Module      : Language.Python.Validate.Scope
Copyright   : (C) CSIRO 2017-2019
License     : BSD3
Maintainer  : Isaac Elliott <isaace71295@gmail.com>
Stability   : experimental
Portability : non-portable
-}

module Language.Python.Validate.Scope
  ( module Data.Validation
  , module Language.Python.Validate.Scope.Error
    -- * Main validation functions
  , Scope, ValidateScope, runValidateScope
  , validateModuleScope
  , validateStatementScope
  , validateExprScope
    -- * Miscellany
    -- ** Extra types
  , Level(..), Entry(..)
    -- ** Extra functions
  , runValidateScope'
  , definitionScope
  , controlScope
  , inScope
  , lookupScope
  , localScope
  , extendScope
    -- ** Validation functions
  , validateArgScope
  , validateAssignExprScope
  , validateBlockScope
  , validateCompoundStatementScope
  , validateComprehensionScope
  , validateDecoratorScope
  , validateDictItemScope
  , validateExceptAsScope
  , validateIdentScope
  , validateListItemScope
  , validateParamScope
  , validateSetItemScope
  , validateSimpleStatementScope
  , validateSubscriptScope
  , validateSuiteScope
  , validateTupleItemScope
  )
where

import Data.Validation

import Control.Lens.Cons (snoc)
import Control.Lens.Fold ((^..), toListOf, folded)
import Control.Lens.Getter ((^.), to, getting)
import Control.Lens.Plated (cosmos)
import Control.Lens.Prism (_Right, _Just)
import Control.Lens.Review ((#))
import Control.Lens.Setter (mapped, over)
import Control.Lens.Tuple (_2, _3)
import Control.Lens.Traversal (traverseOf)
import Control.Monad.State (State, evalState, modify, get, put)
import Control.Monad.Reader (ReaderT, runReaderT, ask, local)
import Data.Bitraversable (bitraverse)
import Data.ByteString (ByteString)
import Data.Coerce (coerce)
import Data.Foldable (toList, traverse_)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Map.Strict (Map)
import Data.Maybe (isJust)
import Data.Sequence ((|>), Seq)
import Data.String (fromString)
import Data.Type.Set (Nub)
import Data.Validate.Monadic
  (ValidateM(..), runValidateM, bindVM, liftVM0, liftVM1, errorVM1)
import Unsafe.Coerce (unsafeCoerce)

import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map.Strict as Map
import Data.Sequence as Seq

import Language.Python.Optics
import Language.Python.Optics.Validated (unvalidated)
import Language.Python.Syntax.Ann
import Language.Python.Syntax.Statement
import Language.Python.Syntax.Expr
import Language.Python.Syntax.Ident
import Language.Python.Syntax.Module
import Language.Python.Validate.Scope.Error

data Scope

data Level
  = Toplevel
  | Definition
  | Control
  deriving (Eq, Show)

data Entry a
  = Entry
  { _entryValue :: a
  , _entryPath :: !(Seq Level)
  } deriving (Eq, Show, Functor)

type ValidateScope ann e
  = ValidateM
      (NonEmpty e)
      (ReaderT (Seq Level) (State (Map ByteString (Entry ann))))

runValidateScope :: ValidateScope ann e a -> Validation (NonEmpty e) a
runValidateScope = runValidateScope' [Toplevel] mempty

runValidateScope' ::
  Seq Level {- ^ Path -} ->
  Map ByteString (Entry ann) {- ^ Context -} ->
  ValidateScope ann e a {- ^ Validation action -} ->
  Validation (NonEmpty e) a
runValidateScope' path s = flip evalState s . flip runReaderT path . runValidateM

localScope ::
  (Map ByteString (Entry ann) -> Map ByteString (Entry ann)) ->
  ValidateScope ann e a ->
  ValidateScope ann e a
localScope f m =
  liftVM0 get `bindVM` \s ->
  liftVM0 (modify f) *>
  m <* liftVM0 (put s)

-- | Run a validation action for a definition block
definitionScope :: ValidateScope ann e a -> ValidateScope ann e a
definitionScope = liftVM1 (local (|> Definition)) . localScope id

-- | Run a validation action for a flow control block
controlScope :: ValidateScope ann e a -> ValidateScope ann e a
controlScope = liftVM1 (local (|> Control))

-- | Add some entries to the context, using the current depth and level
extendScope :: [Ident v ann] -> ValidateScope ann e ()
extendScope entries =
  liftVM0 ask `bindVM` \path ->
  liftVM0 . modify $ \scope ->
    foldr
      (\ident ->
         Map.insert (fromString $ _identValue ident) (Entry (ident ^. annot_) path))
      scope
      entries

inScope :: String -> ValidateScope ann e Bool
inScope = fmap isJust . lookupScope

lookupScope :: String -> ValidateScope ann e (Maybe (Entry ann))
lookupScope s = Map.lookup (fromString s) <$> liftVM0 get 

validateExceptAsScope
  :: AsScopeError e a
  => ExceptAs v a
  -> ValidateScope a e (ExceptAs (Nub (Scope ': v)) a)
validateExceptAsScope (ExceptAs ann e f) =
  ExceptAs ann <$>
  validateExprScope e <*>
  pure (over (mapped._2) coerce f)

validateSuiteScope
  :: AsScopeError e a
  => Suite v a
  -> ValidateScope a e (Suite (Nub (Scope ': v)) a)
validateSuiteScope (SuiteMany ann a b c d) = SuiteMany ann a b c <$> validateBlockScope d
validateSuiteScope (SuiteOne ann a b) =
  SuiteOne ann a <$> validateSmallStatementScope b

validateDecoratorScope
  :: AsScopeError e a
  => Decorator v a
  -> ValidateScope a e (Decorator (Nub (Scope ': v)) a)
validateDecoratorScope (Decorator a b c d e f g) =
  (\d' -> Decorator a b c d' e f g) <$>
  validateExprScope d

parallel2 ::
  ValidateScope a e x ->
  ValidateScope a e y ->
  ValidateScope a e (x, y)
parallel2 a b =
  liftVM0 get `bindVM` \st ->
  ((,) <$>
   ((,) <$ liftVM0 (put st) <*> a <*> liftVM0 get) <*>
   ((,) <$ liftVM0 (put st) <*> b <*> liftVM0 get)) `bindVM`
  \((ares, ast), (bres, bst)) ->
  (ares, bres) <$
    liftVM0
    (put $
     Map.unionWith
       (\e1 e2 ->
          if Seq.length (_entryPath e1) < Seq.length (_entryPath e2)
          then e2
          else e1)
       ast
       bst)

parallelList ::
  (x -> ValidateScope a e y) ->
  [x] ->
  ValidateScope a e [y]
parallelList _ [] = pure []
parallelList f (x:xs) = uncurry (:) <$> parallel2 (f x) (parallelList f xs)

parallelNonEmpty ::
  (x -> ValidateScope a e y) ->
  NonEmpty x ->
  ValidateScope a e (NonEmpty y)
parallelNonEmpty f (x:|xs) = uncurry (:|) <$> parallel2 (f x) (parallelList f xs)

parallel3 ::
  ValidateScope a e x1 ->
  ValidateScope a e x2 ->
  ValidateScope a e x3 ->
  ValidateScope a e (x1, x2, x3)
parallel3 a b c = (\(a', (b', c')) -> (a', b', c')) <$> parallel2 a (parallel2 b c)

parallel4 ::
  ValidateScope a e x1 ->
  ValidateScope a e x2 ->
  ValidateScope a e x3 ->
  ValidateScope a e x4 ->
  ValidateScope a e (x1, x2, x3, x4)
parallel4 a b c d =
  (\(a', (b', c', d')) -> (a', b', c', d')) <$> parallel2 a (parallel3 b c d)

validateCompoundStatementScope
  :: forall e v a
   . AsScopeError e a
  => CompoundStatement v a
  -> ValidateScope a e (CompoundStatement (Nub (Scope ': v)) a)
validateCompoundStatementScope (Fundef a decos idnts asyncWs ws1 name ws2 params ws3 mty s) =
  (\decos' -> Fundef a decos' idnts asyncWs ws1 (coerce name) ws2) <$>
  traverse validateDecoratorScope decos <*>
  traverse validateParamScope params <*>
  pure ws3 <*>
  traverseOf (traverse._2) validateExprScope mty <*>
  definitionScope
    (extendScope (name : toListOf (folded.getting paramName) params) *>
     validateSuiteScope s) <*
  extendScope [name]
validateCompoundStatementScope (If idnts a ws1 e b elifs melse) =
  (\e' (b', elifs', melse') -> If idnts a ws1 e' b' elifs' melse') <$>
  validateExprScope e <*>
  parallel3
    (controlScope $ validateSuiteScope b)
    (parallelList
     (\(a, b, c, d) ->
       (,,,) a b <$>
       validateExprScope c <*>
       controlScope (validateSuiteScope d))
     elifs)
    (traverseOf (traverse._3) (controlScope . validateSuiteScope) melse)
validateCompoundStatementScope (While idnts a ws1 e b els) =
  While idnts a ws1 <$>
  validateExprScope e <*>
  controlScope (validateSuiteScope b) <*>
  traverseOf (traverse._3) (controlScope . validateSuiteScope) els
validateCompoundStatementScope (TryExcept idnts a b e f k l) =
  (\(e', f', k', l') -> TryExcept idnts a b e' f' k' l') <$>
  parallel4
    (controlScope $ validateSuiteScope e)
    (parallelNonEmpty
       (\(idnts, ws, g, h) ->
         (,,,) idnts ws <$>
         traverse validateExceptAsScope g <*>
         controlScope
         (extendScope (toListOf (folded.exceptAsName._Just._2) g) *>
          validateSuiteScope h))
       f)
    (traverseOf (traverse._3) (controlScope . validateSuiteScope) k)
    (traverseOf (traverse._3) (controlScope . validateSuiteScope) l)
validateCompoundStatementScope (TryFinally idnts a b e idnts2 f i) =
  (\(e', i') -> TryFinally idnts a b e' idnts2 f i') <$>
  parallel2
    (controlScope $ validateSuiteScope e)
    (controlScope $ validateSuiteScope i)
validateCompoundStatementScope (For idnts a asyncWs b c d e h i) =
  let
    cs = c ^.. unvalidated.cosmos._Ident
  in
    (\c' d' e' (h', i') -> For idnts a asyncWs b c' d' e' h' i') <$>
    (unsafeCoerce c <$
     traverse
       (\s ->
         inScope (s ^. identValue) `bindVM` \res ->
         if res then errorVM1 (_BadShadowing # coerce s) else pure ())
       cs) <*>
    pure d <*>
    traverse validateExprScope e <*>
    parallel2
      (controlScope $
       extendScope (toList cs) *>
       validateSuiteScope h)
      (traverseOf (traverse._3) (controlScope . validateSuiteScope) i)
validateCompoundStatementScope (ClassDef a decos idnts b c d g) =
  (\decos' -> ClassDef a decos' idnts b (coerce c)) <$>
  traverse validateDecoratorScope decos <*>
  traverseOf (traverse._2.traverse.traverse) validateArgScope d <*>
  definitionScope (validateSuiteScope g) <*
  extendScope [c]
validateCompoundStatementScope (With a b asyncWs c d e) =
  let
    names =
      d ^..
      folded.unvalidated.to _withItemBinder.folded._2.
      assignTargets
  in
    With a b asyncWs c <$>
    traverse
      (\(WithItem a b c) ->
         WithItem @(Nub (Scope ': v)) a <$>
         validateExprScope b <*>
         traverseOf (traverse._2) validateAssignExprScope c)
      d <*
    extendScope names <*>
    controlScope (validateSuiteScope e)

validateSimpleStatementScope
  :: AsScopeError e a
  => SimpleStatement v a
  -> ValidateScope a e (SimpleStatement (Nub (Scope ': v)) a)
validateSimpleStatementScope (Assert a b c d) =
  Assert a b <$>
  validateExprScope c <*>
  traverseOf (traverse._2) validateExprScope d
validateSimpleStatementScope (Raise a ws f) =
  Raise a ws <$>
  traverse
    (\(b, c) ->
       (,) <$>
       validateExprScope b <*>
       traverseOf (traverse._2) validateExprScope c)
    f
validateSimpleStatementScope (Return a ws e) = Return a ws <$> traverse validateExprScope e
validateSimpleStatementScope (Expr a e) = Expr a <$> validateExprScope e
validateSimpleStatementScope (Assign a l rs) =
  Assign a <$>
  validateAssignExprScope l <*>
  ((\a b -> case a of; [] -> b :| []; a : as -> a :| snoc as b) <$>
   traverseOf (traverse._2) validateAssignExprScope (NonEmpty.init rs) <*>
   (\(ws, b) -> (,) ws <$> validateExprScope b) (NonEmpty.last rs))
validateSimpleStatementScope (AugAssign a l aa r) =
  (\l' -> AugAssign a l' aa) <$>
  validateExprScope l <*>
  validateExprScope r
validateSimpleStatementScope (Global a _ _) = errorVM1 (_FoundGlobal # getAnn a)
validateSimpleStatementScope (Nonlocal a _ _) = errorVM1 (_FoundNonlocal # getAnn a)
validateSimpleStatementScope (Del a ws cs) =
  Del a ws <$
  traverse_
    (\case; Ident a _ -> errorVM1 (_DeletedIdent # getAnn a); _ -> pure ())
    cs <*>
  traverse validateExprScope cs
validateSimpleStatementScope s@Pass{} = pure $ unsafeCoerce s
validateSimpleStatementScope s@Break{} = pure $ unsafeCoerce s
validateSimpleStatementScope s@Continue{} = pure $ unsafeCoerce s
validateSimpleStatementScope s@Import{} = pure $ unsafeCoerce s
validateSimpleStatementScope s@From{} = pure $ unsafeCoerce s

validateSmallStatementScope
  :: AsScopeError e a
  => SmallStatement v a
  -> ValidateScope a e (SmallStatement (Nub (Scope ': v)) a)
validateSmallStatementScope (MkSmallStatement s ss sc cmt nl) =
  (\s' ss' -> MkSmallStatement s' ss' sc cmt nl) <$>
  validateSimpleStatementScope s <*>
  traverseOf (traverse._2) validateSimpleStatementScope ss

validateStatementScope
  :: AsScopeError e a
  => Statement v a
  -> ValidateScope a e (Statement (Nub (Scope ': v)) a)
validateStatementScope (CompoundStatement c) =
  CompoundStatement <$> validateCompoundStatementScope c
validateStatementScope (SmallStatement idnts a) =
  SmallStatement idnts <$> validateSmallStatementScope a

validateIdentScope
  :: AsScopeError e a
  => Ident v a
  -> ValidateScope a e (Ident (Nub (Scope ': v)) a)
validateIdentScope i =
  lookupScope (_identValue i) `bindVM` \res ->
  liftVM0 ask `bindVM` \curPath ->
    case res of
      Nothing -> errorVM1 (_NotInScope # (i ^. unvalidated))
      Just (Entry ann path) ->
        coerce i <$
        if Seq.length curPath < Seq.length path
        then errorVM1 (_FoundDynamic # (ann, i ^. unvalidated))
        else pure ()

validateArgScope
  :: AsScopeError e a
  => Arg v a
  -> ValidateScope a e (Arg (Nub (Scope ': v)) a)
validateArgScope (PositionalArg a e) =
  PositionalArg a <$> validateExprScope e
validateArgScope (KeywordArg a ident ws2 expr) =
  KeywordArg a (coerce ident) ws2 <$> validateExprScope expr
validateArgScope (StarArg a ws e) =
  StarArg a ws <$> validateExprScope e
validateArgScope (DoubleStarArg a ws e) =
  DoubleStarArg a ws <$> validateExprScope e

validateParamScope
  :: AsScopeError e a
  => Param v a
  -> ValidateScope a e (Param (Nub (Scope ': v)) a)
validateParamScope (PositionalParam a ident mty) =
  PositionalParam a (coerce ident) <$>
  traverseOf (traverse._2) validateExprScope mty
validateParamScope (KeywordParam a ident mty ws2 expr) =
  KeywordParam a (coerce ident) <$>
  traverseOf (traverse._2) validateExprScope mty <*>
  pure ws2 <*>
  validateExprScope expr
validateParamScope (StarParam a b c d) =
  StarParam a b (coerce c) <$>
  traverseOf (traverse._2) validateExprScope d
validateParamScope (UnnamedStarParam a b) = pure $ UnnamedStarParam a b
validateParamScope (DoubleStarParam a b c d) =
  DoubleStarParam a b (coerce c) <$>
  traverseOf (traverse._2) validateExprScope d

validateBlockScope
  :: AsScopeError e a
  => Block v a
  -> ValidateScope a e (Block (Nub (Scope ': v)) a)
validateBlockScope (Block x b bs) =
  Block x <$>
  validateStatementScope b <*>
  traverseOf (traverse._Right) validateStatementScope bs

validateComprehensionScope
  :: AsScopeError e a
  => (ex v a -> ValidateScope a e (ex (Nub (Scope ': v)) a))
  -> Comprehension ex v a
  -> ValidateScope a e (Comprehension ex (Nub (Scope ': v)) a)
validateComprehensionScope f (Comprehension a b c d) =
  controlScope $
  (\c' d' b' -> Comprehension a b' c' d') <$>
  validateCompForScope c <*>
  traverse (bitraverse validateCompForScope validateCompIfScope) d <*>
  f b
  where
    validateCompForScope
      :: AsScopeError e a
      => CompFor v a
      -> ValidateScope a e (CompFor (Nub (Scope ': v)) a)
    validateCompForScope (CompFor a b c d e) =
      (\c' -> CompFor a b c' d) <$>
      validateAssignExprScope c <*>
      validateExprScope e <*
      extendScope (c ^.. unvalidated.assignTargets)

    validateCompIfScope
      :: AsScopeError e a
      => CompIf v a
      -> ValidateScope a e (CompIf (Nub (Scope ': v)) a)
    validateCompIfScope (CompIf a b c) =
      CompIf a b <$> validateExprScope c

validateAssignExprScope
  :: AsScopeError e a
  => Expr v a
  -> ValidateScope a e (Expr (Nub (Scope ': v)) a)
validateAssignExprScope (Subscript a e1 ws1 e2 ws2) =
  (\e1' e2' -> Subscript a e1' ws1 e2' ws2) <$>
  validateAssignExprScope e1 <*>
  traverse validateSubscriptScope e2
validateAssignExprScope (List a ws1 es ws2) =
  List a ws1 <$>
  traverseOf (traverse.traverse) listItem es <*>
  pure ws2
  where
    listItem (ListItem a b) = ListItem a <$> validateAssignExprScope b
    listItem (ListUnpack a b c d) = ListUnpack a b c <$> validateAssignExprScope d
validateAssignExprScope (Deref a e ws1 r) =
  Deref a <$>
  validateExprScope e <*>
  pure ws1 <*>
  validateIdentScope r
validateAssignExprScope (Parens a ws1 e ws2) =
  Parens a ws1 <$>
  validateAssignExprScope e <*>
  pure ws2
validateAssignExprScope (Tuple a b ws d) =
  Tuple a <$>
  tupleItem b <*>
  pure ws <*>
  traverseOf (traverse.traverse) tupleItem d
  where
    tupleItem (TupleItem a b) = TupleItem a <$> validateAssignExprScope b
    tupleItem (TupleUnpack a b c d) = TupleUnpack a b c <$> validateAssignExprScope d
validateAssignExprScope (Ident a (MkIdent b c d)) =
  lookupScope c `bindVM` \res ->
  liftVM0 ask `bindVM` \curPath ->
  Ident a (MkIdent b c d) <$
  case res of
    Nothing -> extendScope [MkIdent b c d]
    Just (Entry _ path)->
      if Seq.length curPath < Seq.length path
      then extendScope [MkIdent b c d]
      else pure ()
validateAssignExprScope e@Unit{} = pure $ unsafeCoerce e
validateAssignExprScope e@Lambda{} = pure $ unsafeCoerce e
validateAssignExprScope e@Yield{} = pure $ unsafeCoerce e
validateAssignExprScope e@YieldFrom{} = pure $ unsafeCoerce e
validateAssignExprScope e@Not{} = pure $ unsafeCoerce e
validateAssignExprScope e@ListComp{} = pure $ unsafeCoerce e
validateAssignExprScope e@Call{} = pure $ unsafeCoerce e
validateAssignExprScope e@UnOp{} = pure $ unsafeCoerce e
validateAssignExprScope e@BinOp{} = pure $ unsafeCoerce e
validateAssignExprScope e@None{} = pure $ unsafeCoerce e
validateAssignExprScope e@Ellipsis{} = pure $ unsafeCoerce e
validateAssignExprScope e@Int{} = pure $ unsafeCoerce e
validateAssignExprScope e@Float{} = pure $ unsafeCoerce e
validateAssignExprScope e@Imag{} = pure $ unsafeCoerce e
validateAssignExprScope e@Bool{} = pure $ unsafeCoerce e
validateAssignExprScope e@String{} = pure $ unsafeCoerce e
validateAssignExprScope e@DictComp{} = pure $ unsafeCoerce e
validateAssignExprScope e@Dict{} = pure $ unsafeCoerce e
validateAssignExprScope e@SetComp{} = pure $ unsafeCoerce e
validateAssignExprScope e@Set{} = pure $ unsafeCoerce e
validateAssignExprScope e@Generator{} = pure $ unsafeCoerce e
validateAssignExprScope e@Await{} = pure $ unsafeCoerce e
validateAssignExprScope e@Ternary{} = pure $ unsafeCoerce e

validateDictItemScope
  :: AsScopeError e a
  => DictItem v a
  -> ValidateScope a e (DictItem (Nub (Scope ': v)) a)
validateDictItemScope (DictItem a b c d) =
  (\b' -> DictItem a b' c) <$>
  validateExprScope b <*>
  validateExprScope d
validateDictItemScope (DictUnpack a b c) =
  DictUnpack a b <$> validateExprScope c

validateSubscriptScope
  :: AsScopeError e a
  => Subscript v a
  -> ValidateScope a e (Subscript (Nub (Scope ': v)) a)
validateSubscriptScope (SubscriptExpr e) = SubscriptExpr <$> validateExprScope e
validateSubscriptScope (SubscriptSlice a b c d) =
  (\a' -> SubscriptSlice a' b) <$>
  traverse validateExprScope a <*>
  traverse validateExprScope c <*>
  traverseOf (traverse._2.traverse) validateExprScope d

validateListItemScope
  :: AsScopeError e a
  => ListItem v a
  -> ValidateScope a e (ListItem (Nub (Scope ': v)) a)
validateListItemScope (ListItem a b) = ListItem a <$> validateExprScope b
validateListItemScope (ListUnpack a b c d) = ListUnpack a b c <$> validateExprScope d

validateSetItemScope
  :: AsScopeError e a
  => SetItem v a
  -> ValidateScope a e (SetItem (Nub (Scope ': v)) a)
validateSetItemScope (SetItem a b) = SetItem a <$> validateExprScope b
validateSetItemScope (SetUnpack a b c d) = SetUnpack a b c <$> validateExprScope d

validateTupleItemScope
  :: AsScopeError e a
  => TupleItem v a
  -> ValidateScope a e (TupleItem (Nub (Scope ': v)) a)
validateTupleItemScope (TupleItem a b) = TupleItem a <$> validateExprScope b
validateTupleItemScope (TupleUnpack a b c d) = TupleUnpack a b c <$> validateExprScope d

validateExprScope
  :: AsScopeError e a
  => Expr v a
  -> ValidateScope a e (Expr (Nub (Scope ': v)) a)
validateExprScope (Lambda a b c d e) =
  Lambda a b <$>
  traverse validateParamScope c <*>
  pure d <*>
  validateExprScope e
validateExprScope (Yield a b c) =
  Yield a b <$> traverse validateExprScope c
validateExprScope (YieldFrom a b c d) =
  YieldFrom a b c <$> validateExprScope d
validateExprScope (Ternary a b c d e f) =
  (\b' d' f' -> Ternary a b' c d' e f') <$>
  validateExprScope b <*>
  validateExprScope d <*>
  validateExprScope f
validateExprScope (Subscript a b c d e) =
  (\b' d' -> Subscript a b' c d' e) <$>
  validateExprScope b <*>
  traverse validateSubscriptScope d
validateExprScope (Not a ws e) = Not a ws <$> validateExprScope e
validateExprScope (List a ws1 es ws2) =
  List a ws1 <$>
  traverseOf (traverse.traverse) validateListItemScope es <*>
  pure ws2
validateExprScope (ListComp a ws1 comp ws2) =
  ListComp a ws1 <$>
  validateComprehensionScope validateExprScope comp <*>
  pure ws2
validateExprScope (Generator a comp) =
  Generator a <$>
  validateComprehensionScope validateExprScope comp
validateExprScope (Await a ws expr) = Await a ws <$> validateExprScope expr
validateExprScope (Deref a e ws1 r) =
  Deref a <$>
  validateExprScope e <*>
  pure ws1 <*>
  validateIdentScope r
validateExprScope (Call a e ws1 as ws2) =
  Call a <$>
  validateExprScope e <*>
  pure ws1 <*>
  traverseOf (traverse.traverse) validateArgScope as <*>
  pure ws2
validateExprScope (BinOp a l op r) =
  BinOp a <$>
  validateExprScope l <*>
  pure op <*>
  validateExprScope r
validateExprScope (UnOp a op e) =
  UnOp a op <$>
  validateExprScope e
validateExprScope (Parens a ws1 e ws2) =
  Parens a ws1 <$>
  validateExprScope e <*>
  pure ws2
validateExprScope (Ident a i) = Ident a <$> validateIdentScope i
validateExprScope (Tuple a b ws d) =
  Tuple a <$>
  validateTupleItemScope b <*>
  pure ws <*>
  traverseOf (traverse.traverse) validateTupleItemScope d
validateExprScope e@None{} = pure $ unsafeCoerce e
validateExprScope e@Ellipsis{} = pure $ unsafeCoerce e
validateExprScope e@Int{} = pure $ unsafeCoerce e
validateExprScope e@Float{} = pure $ unsafeCoerce e
validateExprScope e@Imag{} = pure $ unsafeCoerce e
validateExprScope e@Bool{} = pure $ unsafeCoerce e
validateExprScope e@String{} = pure $ unsafeCoerce e
validateExprScope e@Unit{} = pure $ unsafeCoerce e
validateExprScope (DictComp a ws1 comp ws2) =
  DictComp a ws1 <$>
  validateComprehensionScope validateDictItemScope comp <*>
  pure ws2
validateExprScope (Dict a b c d) =
  (\c' -> Dict a b c' d) <$> traverseOf (traverse.traverse) validateDictItemScope c
validateExprScope (SetComp a ws1 comp ws2) =
  SetComp a ws1 <$>
  validateComprehensionScope validateSetItemScope comp <*>
  pure ws2
validateExprScope (Set a b c d) =
  (\c' -> Set a b c' d) <$> traverse validateSetItemScope c

validateModuleScope
  :: AsScopeError e a
  => Module v a
  -> ValidateScope a e (Module (Nub (Scope ': v)) a)
validateModuleScope m =
  case m of
    ModuleEmpty -> pure ModuleEmpty
    ModuleBlankFinal a -> pure $ ModuleBlankFinal a
    ModuleBlank a b c -> ModuleBlank a b <$> validateModuleScope c
    ModuleStatement a b ->
     ModuleStatement <$>
     validateStatementScope a <*>
     validateModuleScope b