{-# LANGUAGE MultiWayIf #-}
module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.GADTsChecker where
import Control.Reference ((^.), (&))
import Control.Monad.Trans.Maybe (MaybeT(..))
import Language.Haskell.Tools.AST
import Language.Haskell.Tools.Refactor
import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
chkGADTsGadtConDecl :: CheckNode GadtConDecl
chkGADTsGadtConDecl = conditional chkGADTsGadtConDecl' GADTSyntax
chkConDeclForExistentials :: CheckNode ConDecl
chkConDeclForExistentials = conditionalAny chkConDeclForExistentials' [GADTs, ExistentialQuantification]
chkGADTsGadtConDecl' :: CheckNode GadtConDecl
chkGADTsGadtConDecl' conDecl = do
let conNames = conDecl ^. (gadtConNames & annListElems)
mres <- mapM (runMaybeT . isVanillaDataConNameM) conNames
addEvidence_ GADTSyntax conDecl
if | any isNothing mres ->
addRelationMI (GADTs `lOr` ExistentialQuantification) conDecl
| any (not . fromJust) mres ->
addRelation (GADTs `lOr` ExistentialQuantification) conDecl
| otherwise -> return conDecl
chkConDeclForExistentials' :: CheckNode ConDecl
chkConDeclForExistentials' conDecl =
fromMaybeTM (addRelationMI (GADTs `lOr` ExistentialQuantification) conDecl) $
case conDecl ^. element of
UConDecl _ _ n _ -> chkName n
URecordDecl _ _ n _ -> chkName n
UInfixConDecl _ _ _ op _ -> chkName (op ^. operatorName)
where chkName :: HasNameInfo' n => n -> MaybeT ExtMonad ConDecl
chkName n = do
isVanilla <- isVanillaDataConNameM n
if isVanilla
then return conDecl
else lift . addRelation (GADTs `lOr` ExistentialQuantification) $ conDecl