{-# LANGUAGE FlexibleContexts, TupleSections #-}

module HSE.Util(module HSE.Util, def) where

import Control.Monad
import Data.Default
import Data.Tuple.Extra
import Data.List
import Language.Haskell.Exts.Util
import Control.Monad.Trans.State
import qualified Data.Map as Map
import Data.Maybe
import Data.Data hiding (Fixity)
import System.FilePath
import HSE.Type
import Data.Functor
import Prelude


---------------------------------------------------------------------
-- ACCESSOR/TESTER

ellipses :: QName S
ellipses :: QName S
ellipses = S -> Name S -> QName S
forall l. l -> Name l -> QName l
UnQual S
an (Name S -> QName S) -> Name S -> QName S
forall a b. (a -> b) -> a -> b
$ S -> String -> Name S
forall l. l -> String -> Name l
Ident S
an "..." -- Must be an Ident, not a Symbol

opExp :: QOp S -> Exp_
opExp :: QOp S -> Exp_
opExp (QVarOp s :: S
s op :: QName S
op) = S -> QName S -> Exp_
forall l. l -> QName l -> Exp l
Var S
s QName S
op
opExp (QConOp s :: S
s op :: QName S
op) = S -> QName S -> Exp_
forall l. l -> QName l -> Exp l
Con S
s QName S
op

expOp :: Exp_ -> Maybe (QOp S)
expOp :: Exp_ -> Maybe (QOp S)
expOp (Var s :: S
s op :: QName S
op) = QOp S -> Maybe (QOp S)
forall a. a -> Maybe a
Just (QOp S -> Maybe (QOp S)) -> QOp S -> Maybe (QOp S)
forall a b. (a -> b) -> a -> b
$ S -> QName S -> QOp S
forall l. l -> QName l -> QOp l
QVarOp S
s QName S
op
expOp (Con s :: S
s op :: QName S
op) = QOp S -> Maybe (QOp S)
forall a. a -> Maybe a
Just (QOp S -> Maybe (QOp S)) -> QOp S -> Maybe (QOp S)
forall a b. (a -> b) -> a -> b
$ S -> QName S -> QOp S
forall l. l -> QName l -> QOp l
QConOp S
s QName S
op
expOp _ = Maybe (QOp S)
forall a. Maybe a
Nothing

moduleDecls :: Module_ -> [Decl_]
moduleDecls :: Module_ -> [Decl_]
moduleDecls (Module _ _ _ _ xs :: [Decl_]
xs) = [Decl_]
xs
moduleDecls _ = [] -- XmlPage/XmlHybrid

moduleName :: Module_ -> String
moduleName :: Module_ -> String
moduleName (Module _ Nothing _ _ _) = "Main"
moduleName (Module _ (Just (ModuleHead _ (ModuleName _ x :: String
x) _ _)) _ _ _) = String
x
moduleName _ = "" -- XmlPage/XmlHybrid

moduleImports :: Module_ -> [ImportDecl S]
moduleImports :: Module_ -> [ImportDecl S]
moduleImports (Module _ _ _ x :: [ImportDecl S]
x _) = [ImportDecl S]
x
moduleImports _ = [] -- XmlPage/XmlHybrid

modulePragmas :: Module_ -> [ModulePragma S]
modulePragmas :: Module_ -> [ModulePragma S]
modulePragmas (Module _ _ x :: [ModulePragma S]
x _ _) = [ModulePragma S]
x
modulePragmas _ = [] -- XmlPage/XmlHybrid

moduleExtensions :: Module_ -> [Name S]
moduleExtensions :: Module_ -> [Name S]
moduleExtensions x :: Module_
x = [[Name S]] -> [Name S]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name S]
y | LanguagePragma _ y :: [Name S]
y <- Module_ -> [ModulePragma S]
modulePragmas Module_
x]

fromModuleName :: ModuleName S -> String
fromModuleName :: ModuleName S -> String
fromModuleName (ModuleName _ x :: String
x) = String
x

fromChar :: Exp_ -> Maybe Char
fromChar :: Exp_ -> Maybe Char
fromChar (Lit _ (Char _ x :: Char
x _)) = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x
fromChar _ = Maybe Char
forall a. Maybe a
Nothing

fromPChar :: Pat_ -> Maybe Char
fromPChar :: Pat_ -> Maybe Char
fromPChar (PLit _ _ (Char _ x :: Char
x _)) = Char -> Maybe Char
forall a. a -> Maybe a
Just Char
x
fromPChar _ = Maybe Char
forall a. Maybe a
Nothing

fromString :: Exp_ -> Maybe String
fromString :: Exp_ -> Maybe String
fromString (Lit _ (String _ x :: String
x _)) = String -> Maybe String
forall a. a -> Maybe a
Just String
x
fromString _ = Maybe String
forall a. Maybe a
Nothing

fromPString :: Pat_ -> Maybe String
fromPString :: Pat_ -> Maybe String
fromPString (PLit _ _ (String _ x :: String
x _)) =  String -> Maybe String
forall a. a -> Maybe a
Just String
x
fromPString _ = Maybe String
forall a. Maybe a
Nothing

fromParen1 :: Exp_ -> Exp_
fromParen1 :: Exp_ -> Exp_
fromParen1 (Paren _ x :: Exp_
x) = Exp_
x
fromParen1 x :: Exp_
x = Exp_
x

fromParen :: Exp_ -> Exp_
fromParen :: Exp_ -> Exp_
fromParen (Paren _ x :: Exp_
x) = Exp_ -> Exp_
fromParen Exp_
x
fromParen x :: Exp_
x = Exp_
x

fromPParen :: Pat s -> Pat s
fromPParen :: Pat s -> Pat s
fromPParen (PParen _ x :: Pat s
x) = Pat s -> Pat s
forall s. Pat s -> Pat s
fromPParen Pat s
x
fromPParen x :: Pat s
x = Pat s
x

fromTyParen :: Type s -> Type s
fromTyParen :: Type s -> Type s
fromTyParen (TyParen _ x :: Type s
x) = Type s -> Type s
forall s. Type s -> Type s
fromTyParen Type s
x
fromTyParen x :: Type s
x = Type s
x

fromTyBang :: Type s -> Type s
fromTyBang :: Type s -> Type s
fromTyBang (TyBang _ _ _ x :: Type s
x) = Type s
x
fromTyBang x :: Type s
x = Type s
x

-- is* :: Exp_ -> Bool
-- is* :: Decl_ -> Bool
isVar :: Exp l -> Bool
isVar Var{} = Bool
True; isVar _ = Bool
False
isCon :: Exp l -> Bool
isCon Con{} = Bool
True; isCon _ = Bool
False
isApp :: Exp l -> Bool
isApp App{} = Bool
True; isApp _ = Bool
False
isInfixApp :: Exp l -> Bool
isInfixApp InfixApp{} = Bool
True; isInfixApp _ = Bool
False
isAnyApp :: Exp l -> Bool
isAnyApp x :: Exp l
x = Exp l -> Bool
forall l. Exp l -> Bool
isApp Exp l
x Bool -> Bool -> Bool
|| Exp l -> Bool
forall l. Exp l -> Bool
isInfixApp Exp l
x
isParen :: Exp l -> Bool
isParen Paren{} = Bool
True; isParen _ = Bool
False
isIf :: Exp l -> Bool
isIf If{} = Bool
True; isIf _ = Bool
False
isLambda :: Exp l -> Bool
isLambda Lambda{} = Bool
True; isLambda _ = Bool
False
isMDo :: Exp l -> Bool
isMDo MDo{} = Bool
True; isMDo _ = Bool
False
isBoxed :: Boxed -> Bool
isBoxed Boxed{} = Bool
True; isBoxed _ = Bool
False
isDerivDecl :: Decl l -> Bool
isDerivDecl DerivDecl{} = Bool
True; isDerivDecl _ = Bool
False
isPBangPat :: Pat l -> Bool
isPBangPat PBangPat{} = Bool
True; isPBangPat _ = Bool
False
isPFieldPun :: PatField l -> Bool
isPFieldPun PFieldPun{} = Bool
True; isPFieldPun _ = Bool
False
isFieldPun :: FieldUpdate l -> Bool
isFieldPun FieldPun{} = Bool
True; isFieldPun _ = Bool
False
isPWildCard :: Pat l -> Bool
isPWildCard PWildCard{} = Bool
True; isPWildCard _ = Bool
False
isPFieldWildcard :: PatField l -> Bool
isPFieldWildcard PFieldWildcard{} = Bool
True; isPFieldWildcard _ = Bool
False
isFieldWildcard :: FieldUpdate l -> Bool
isFieldWildcard FieldWildcard{} = Bool
True; isFieldWildcard _ = Bool
False
isPViewPat :: Pat l -> Bool
isPViewPat PViewPat{} = Bool
True; isPViewPat _ = Bool
False
isParComp :: Exp l -> Bool
isParComp ParComp{} = Bool
True; isParComp _ = Bool
False
isTypeApp :: Exp l -> Bool
isTypeApp TypeApp{} = Bool
True; isTypeApp _ = Bool
False
isPatTypeSig :: Pat l -> Bool
isPatTypeSig PatTypeSig{} = Bool
True; isPatTypeSig _ = Bool
False
isQuasiQuote :: Exp l -> Bool
isQuasiQuote QuasiQuote{} = Bool
True; isQuasiQuote _ = Bool
False
isTyQuasiQuote :: Type l -> Bool
isTyQuasiQuote TyQuasiQuote{} = Bool
True; isTyQuasiQuote _ = Bool
False
isSpliceDecl :: Decl l -> Bool
isSpliceDecl SpliceDecl{} = Bool
True; isSpliceDecl _ = Bool
False
isNewType :: DataOrNew l -> Bool
isNewType NewType{} = Bool
True; isNewType _ = Bool
False
isRecStmt :: Stmt l -> Bool
isRecStmt RecStmt{} = Bool
True; isRecStmt _ = Bool
False
isClsDefSig :: ClassDecl l -> Bool
isClsDefSig ClsDefSig{} = Bool
True; isClsDefSig _ = Bool
False
isTyBang :: Type l -> Bool
isTyBang TyBang{} = Bool
True; isTyBang _ = Bool
False
isLCase :: Exp l -> Bool
isLCase LCase{} = Bool
True; isLCase _ = Bool
False
isTupleSection :: Exp l -> Bool
isTupleSection TupleSection{} = Bool
True; isTupleSection _ = Bool
False
isString :: Literal l -> Bool
isString String{} = Bool
True; isString _ = Bool
False
isRecUpdate :: Exp l -> Bool
isRecUpdate RecUpdate{} = Bool
True; isRecUpdate _ = Bool
False
isRecConstr :: Exp l -> Bool
isRecConstr RecConstr{} = Bool
True; isRecConstr _ = Bool
False

isSection :: Exp l -> Bool
isSection LeftSection{} = Bool
True
isSection RightSection{} = Bool
True
isSection _ = Bool
False

isPrimLiteral :: Literal l -> Bool
isPrimLiteral PrimInt{} = Bool
True
isPrimLiteral PrimWord{} = Bool
True
isPrimLiteral PrimFloat{} = Bool
True
isPrimLiteral PrimDouble{} = Bool
True
isPrimLiteral PrimChar{} = Bool
True
isPrimLiteral PrimString{} = Bool
True
isPrimLiteral _ = Bool
False


allowRightSection :: String -> Bool
allowRightSection x :: String
x = String
x String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ["-","#"]
allowLeftSection :: String -> Bool
allowLeftSection x :: String
x = String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= "#"


unqual :: QName S -> QName S
unqual :: QName S -> QName S
unqual (Qual an :: S
an _ x :: Name S
x) = S -> Name S -> QName S
forall l. l -> Name l -> QName l
UnQual S
an Name S
x
unqual x :: QName S
x = QName S
x

fromQual :: QName a -> Maybe (Name a)
fromQual :: QName a -> Maybe (Name a)
fromQual (Qual _ _ x :: Name a
x) = Name a -> Maybe (Name a)
forall a. a -> Maybe a
Just Name a
x
fromQual (UnQual _ x :: Name a
x) = Name a -> Maybe (Name a)
forall a. a -> Maybe a
Just Name a
x
fromQual _ = Maybe (Name a)
forall a. Maybe a
Nothing

isSpecial :: QName S -> Bool
isSpecial :: QName S -> Bool
isSpecial Special{} = Bool
True; isSpecial _ = Bool
False

isDol :: QOp S -> Bool
isDol :: QOp S -> Bool
isDol (QVarOp _ (UnQual _ (Symbol _ "$"))) = Bool
True
isDol _ = Bool
False

isDot :: QOp S -> Bool
isDot :: QOp S -> Bool
isDot (QVarOp _ (UnQual _ (Symbol _ "."))) = Bool
True
isDot _ = Bool
False

isDotApp :: Exp_ -> Bool
isDotApp :: Exp_ -> Bool
isDotApp (InfixApp _ _ dot :: QOp S
dot _) | QOp S -> Bool
isDot QOp S
dot = Bool
True
isDotApp _ = Bool
False

dotApp :: Exp_ -> Exp_ -> Exp_
dotApp :: Exp_ -> Exp_ -> Exp_
dotApp x :: Exp_
x = S -> Exp_ -> QOp S -> Exp_ -> Exp_
forall l. l -> Exp l -> QOp l -> Exp l -> Exp l
InfixApp S
an Exp_
x (S -> QName S -> QOp S
forall l. l -> QName l -> QOp l
QVarOp S
an (QName S -> QOp S) -> QName S -> QOp S
forall a b. (a -> b) -> a -> b
$ S -> Name S -> QName S
forall l. l -> Name l -> QName l
UnQual S
an (Name S -> QName S) -> Name S -> QName S
forall a b. (a -> b) -> a -> b
$ S -> String -> Name S
forall l. l -> String -> Name l
Symbol S
an ".")

dotApps :: [Exp_] -> Exp_
dotApps :: [Exp_] -> Exp_
dotApps [] = String -> Exp_
forall a. HasCallStack => String -> a
error "HSE.Util.dotApps, does not work on an empty list"
dotApps [x :: Exp_
x] = Exp_
x
dotApps (x :: Exp_
x:xs :: [Exp_]
xs) = Exp_ -> Exp_ -> Exp_
dotApp Exp_
x ([Exp_] -> Exp_
dotApps [Exp_]
xs)

isReturn :: Exp_ -> Bool
-- Allow both pure and return, as they have the same semantics
isReturn :: Exp_ -> Bool
isReturn (Var _ (UnQual _ (Ident _ x :: String
x))) = String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "return" Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "pure"
isReturn _ = Bool
False

isLexeme :: Exp l -> Bool
isLexeme Var{} = Bool
True
isLexeme Con{} = Bool
True
isLexeme Lit{} = Bool
True
isLexeme _ = Bool
False

isAssocLeft :: Assoc l -> Bool
isAssocLeft AssocLeft{} = Bool
True; isAssocLeft _ = Bool
False
isAssocNone :: Assoc l -> Bool
isAssocNone AssocNone{} = Bool
True; isAssocNone _ = Bool
False

isWHNF :: Exp_ -> Bool
isWHNF :: Exp_ -> Bool
isWHNF Con{} = Bool
True
isWHNF (Lit _ x :: Literal S
x) = case Literal S
x of String{} -> Bool
False; Int{} -> Bool
False; Frac{} -> Bool
False; _ -> Bool
True
isWHNF Lambda{} = Bool
True
isWHNF Tuple{} = Bool
True
isWHNF List{} = Bool
True
isWHNF (Paren _ x :: Exp_
x) = Exp_ -> Bool
isWHNF Exp_
x
isWHNF (ExpTypeSig _ x :: Exp_
x _) = Exp_ -> Bool
isWHNF Exp_
x
-- other (unknown) constructors may have bang patterns in them, so approximate
isWHNF (App _ c :: Exp_
c@Con{} _) | Exp_ -> String
forall a. Pretty a => a -> String
prettyPrint Exp_
c String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["Just","Left","Right"] = Bool
True
isWHNF _ = Bool
False


-- | Like needBracket, but with a special case for a . b . b, which
--   was removed from haskell-src-exts-util-0.2.2
needBracketOld :: Int -> Exp_ -> Exp_ -> Bool
needBracketOld :: Int -> Exp_ -> Exp_ -> Bool
needBracketOld i :: Int
i parent :: Exp_
parent child :: Exp_
child
    | Exp_ -> Bool
isDotApp Exp_
parent, Exp_ -> Bool
isDotApp Exp_
child, Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = Bool
False
    | Bool
otherwise = Int -> Exp_ -> Exp_ -> Bool
forall a. Brackets a => Int -> a -> a -> Bool
needBracket Int
i Exp_
parent Exp_
child

transformBracketOld :: (Exp_ -> Maybe Exp_) -> Exp_ -> Exp_
transformBracketOld :: (Exp_ -> Maybe Exp_) -> Exp_ -> Exp_
transformBracketOld op :: Exp_ -> Maybe Exp_
op = (Bool, Exp_) -> Exp_
forall a b. (a, b) -> b
snd ((Bool, Exp_) -> Exp_) -> (Exp_ -> (Bool, Exp_)) -> Exp_ -> Exp_
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp_ -> (Bool, Exp_)
g
    where
        g :: Exp_ -> (Bool, Exp_)
g = Exp_ -> (Bool, Exp_)
f (Exp_ -> (Bool, Exp_)) -> (Exp_ -> Exp_) -> Exp_ -> (Bool, Exp_)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp_ -> (Bool, Exp_)) -> Exp_ -> Exp_
descendBracketOld Exp_ -> (Bool, Exp_)
g
        f :: Exp_ -> (Bool, Exp_)
f x :: Exp_
x = (Bool, Exp_)
-> (Exp_ -> (Bool, Exp_)) -> Maybe Exp_ -> (Bool, Exp_)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool
False,Exp_
x) (Bool
True,) (Exp_ -> Maybe Exp_
op Exp_
x)

-- | Descend, and if something changes then add/remove brackets appropriately
descendBracketOld :: (Exp_ -> (Bool, Exp_)) -> Exp_ -> Exp_
descendBracketOld :: (Exp_ -> (Bool, Exp_)) -> Exp_ -> Exp_
descendBracketOld op :: Exp_ -> (Bool, Exp_)
op x :: Exp_
x = (Int -> Exp_ -> Exp_) -> Exp_ -> Exp_
forall a. Data a => (Int -> a -> a) -> a -> a
descendIndex Int -> Exp_ -> Exp_
g Exp_
x
    where
        g :: Int -> Exp_ -> Exp_
g i :: Int
i y :: Exp_
y = if Bool
a then Int -> Exp_ -> Exp_
f Int
i Exp_
b else Exp_
b
            where (a :: Bool
a,b :: Exp_
b) = Exp_ -> (Bool, Exp_)
op Exp_
y

        f :: Int -> Exp_ -> Exp_
f i :: Int
i (Paren _ y :: Exp_
y) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Exp_ -> Exp_ -> Bool
needBracketOld Int
i Exp_
x Exp_
y = Exp_
y
        f i :: Int
i y :: Exp_
y           | Int -> Exp_ -> Exp_ -> Bool
needBracketOld Int
i Exp_
x Exp_
y = Exp_ -> Exp_
forall a. Brackets a => a -> a
addParen Exp_
y
        f _ y :: Exp_
y           = Exp_
y

descendIndex :: Data a => (Int -> a -> a) -> a -> a
descendIndex :: (Int -> a -> a) -> a -> a
descendIndex f :: Int -> a -> a
f x :: a
x = (State Int a -> Int -> a) -> Int -> State Int a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int a -> Int -> a
forall s a. State s a -> s -> a
evalState 0 (State Int a -> a) -> State Int a -> a
forall a b. (a -> b) -> a -> b
$ ((a -> State Int a) -> a -> State Int a)
-> a -> (a -> State Int a) -> State Int a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> State Int a) -> a -> State Int a
forall on (m :: * -> *).
(Uniplate on, Monad m) =>
(on -> m on) -> on -> m on
descendM a
x ((a -> State Int a) -> State Int a)
-> (a -> State Int a) -> State Int a
forall a b. (a -> b) -> a -> b
$ \y :: a
y -> do
    Int
i <- StateT Int Identity Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
    (Int -> Int) -> StateT Int Identity ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (Int -> Int -> Int
forall a. Num a => a -> a -> a
+1)
    a -> State Int a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> State Int a) -> a -> State Int a
forall a b. (a -> b) -> a -> b
$ Int -> a -> a
f Int
i a
y


---------------------------------------------------------------------
-- HSE FUNCTIONS

getEquations :: Decl s -> [Decl s]
getEquations :: Decl s -> [Decl s]
getEquations (FunBind s :: s
s xs :: [Match s]
xs) = (Match s -> Decl s) -> [Match s] -> [Decl s]
forall a b. (a -> b) -> [a] -> [b]
map (s -> [Match s] -> Decl s
forall l. l -> [Match l] -> Decl l
FunBind s
s ([Match s] -> Decl s)
-> (Match s -> [Match s]) -> Match s -> Decl s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Match s -> [Match s] -> [Match s]
forall a. a -> [a] -> [a]
:[])) [Match s]
xs
getEquations x :: Decl s
x@PatBind{} = [Decl s -> Decl s
forall s. Decl s -> Decl s
toFunBind Decl s
x]
getEquations x :: Decl s
x = [Decl s
x]


toFunBind :: Decl s -> Decl s
toFunBind :: Decl s -> Decl s
toFunBind (PatBind s :: s
s (PVar _ name :: Name s
name) bod :: Rhs s
bod bind :: Maybe (Binds s)
bind) = s -> [Match s] -> Decl s
forall l. l -> [Match l] -> Decl l
FunBind s
s [s -> Name s -> [Pat s] -> Rhs s -> Maybe (Binds s) -> Match s
forall l.
l -> Name l -> [Pat l] -> Rhs l -> Maybe (Binds l) -> Match l
Match s
s Name s
name [] Rhs s
bod Maybe (Binds s)
bind]
toFunBind x :: Decl s
x = Decl s
x


-- case and if both have branches, nothing else does
replaceBranches :: Exp s -> ([Exp s], [Exp s] -> Exp s)
replaceBranches :: Exp s -> ([Exp s], [Exp s] -> Exp s)
replaceBranches (If s :: s
s a :: Exp s
a b :: Exp s
b c :: Exp s
c) = ([Exp s
b,Exp s
c], \[b :: Exp s
b,c :: Exp s
c] -> s -> Exp s -> Exp s -> Exp s -> Exp s
forall l. l -> Exp l -> Exp l -> Exp l -> Exp l
If s
s Exp s
a Exp s
b Exp s
c)
replaceBranches (Case s :: s
s a :: Exp s
a bs :: [Alt s]
bs) = ((Alt s -> [Exp s]) -> [Alt s] -> [Exp s]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Alt s -> [Exp s]
forall l. Alt l -> [Exp l]
f [Alt s]
bs, s -> Exp s -> [Alt s] -> Exp s
forall l. l -> Exp l -> [Alt l] -> Exp l
Case s
s Exp s
a ([Alt s] -> Exp s) -> ([Exp s] -> [Alt s]) -> [Exp s] -> Exp s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Alt s] -> [Exp s] -> [Alt s]
forall l. [Alt l] -> [Exp l] -> [Alt l]
g [Alt s]
bs)
    where
        f :: Alt l -> [Exp l]
f (Alt _ _ (UnGuardedRhs _ x :: Exp l
x) _) = [Exp l
x]
        f (Alt _ _ (GuardedRhss _ xs :: [GuardedRhs l]
xs) _) = [Exp l
x | GuardedRhs _ _ x :: Exp l
x <- [GuardedRhs l]
xs]
        g :: [Alt l] -> [Exp l] -> [Alt l]
g (Alt s1 :: l
s1 a :: Pat l
a (UnGuardedRhs s2 :: l
s2 _) b :: Maybe (Binds l)
b:rest :: [Alt l]
rest) (x :: Exp l
x:xs :: [Exp l]
xs) = l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt l
s1 Pat l
a (l -> Exp l -> Rhs l
forall l. l -> Exp l -> Rhs l
UnGuardedRhs l
s2 Exp l
x) Maybe (Binds l)
b Alt l -> [Alt l] -> [Alt l]
forall a. a -> [a] -> [a]
: [Alt l] -> [Exp l] -> [Alt l]
g [Alt l]
rest [Exp l]
xs
        g (Alt s1 :: l
s1 a :: Pat l
a (GuardedRhss s2 :: l
s2 ns :: [GuardedRhs l]
ns) b :: Maybe (Binds l)
b:rest :: [Alt l]
rest) xs :: [Exp l]
xs =
                l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
forall l. l -> Pat l -> Rhs l -> Maybe (Binds l) -> Alt l
Alt l
s1 Pat l
a (l -> [GuardedRhs l] -> Rhs l
forall l. l -> [GuardedRhs l] -> Rhs l
GuardedRhss l
s2 [l -> [Stmt l] -> Exp l -> GuardedRhs l
forall l. l -> [Stmt l] -> Exp l -> GuardedRhs l
GuardedRhs l
a [Stmt l]
b Exp l
x | (GuardedRhs a :: l
a b :: [Stmt l]
b _,x :: Exp l
x) <- [GuardedRhs l] -> [Exp l] -> [(GuardedRhs l, Exp l)]
forall a b. [a] -> [b] -> [(a, b)]
zip [GuardedRhs l]
ns [Exp l]
as]) Maybe (Binds l)
b Alt l -> [Alt l] -> [Alt l]
forall a. a -> [a] -> [a]
: [Alt l] -> [Exp l] -> [Alt l]
g [Alt l]
rest [Exp l]
bs
            where (as :: [Exp l]
as,bs :: [Exp l]
bs) = Int -> [Exp l] -> ([Exp l], [Exp l])
forall a. Int -> [a] -> ([a], [a])
splitAt ([GuardedRhs l] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GuardedRhs l]
ns) [Exp l]
xs
        g [] [] = []
        g _ _ = String -> [Alt l]
forall a. HasCallStack => String -> a
error "HSE.Util.replaceBranches: internal invariant failed, lists are of differing lengths"
replaceBranches x :: Exp s
x = ([], \[] -> Exp s
x)


---------------------------------------------------------------------
-- VECTOR APPLICATION


apps :: [Exp_] -> Exp_
apps :: [Exp_] -> Exp_
apps = (Exp_ -> Exp_ -> Exp_) -> [Exp_] -> Exp_
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (S -> Exp_ -> Exp_ -> Exp_
forall l. l -> Exp l -> Exp l -> Exp l
App S
an)

fromApps :: Exp_ -> [Exp_]
fromApps :: Exp_ -> [Exp_]
fromApps = ((Exp_, S) -> Exp_) -> [(Exp_, S)] -> [Exp_]
forall a b. (a -> b) -> [a] -> [b]
map (Exp_, S) -> Exp_
forall a b. (a, b) -> a
fst ([(Exp_, S)] -> [Exp_]) -> (Exp_ -> [(Exp_, S)]) -> Exp_ -> [Exp_]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Exp_ -> [(Exp_, S)]
fromAppsWithLoc

fromAppsWithLoc :: Exp_ -> [(Exp_, S)]
fromAppsWithLoc :: Exp_ -> [(Exp_, S)]
fromAppsWithLoc (App l :: S
l x :: Exp_
x y :: Exp_
y) = Exp_ -> [(Exp_, S)]
fromAppsWithLoc Exp_
x [(Exp_, S)] -> [(Exp_, S)] -> [(Exp_, S)]
forall a. [a] -> [a] -> [a]
++ [(Exp_
y, S
l)]
fromAppsWithLoc x :: Exp_
x = [(Exp_
x, Exp_ -> S
forall (ast :: * -> *) l. Annotated ast => ast l -> l
ann Exp_
x)]


-- Rule for the Uniplate Apps functions
-- Given (f a) b, consider the children to be: children f ++ [a,b]

childrenApps :: Exp_ -> [Exp_]
childrenApps :: Exp_ -> [Exp_]
childrenApps (App s :: S
s x :: Exp_
x y :: Exp_
y) = Exp_ -> [Exp_]
childrenApps Exp_
x [Exp_] -> [Exp_] -> [Exp_]
forall a. [a] -> [a] -> [a]
++ [Exp_
y]
childrenApps x :: Exp_
x = Exp_ -> [Exp_]
forall on. Uniplate on => on -> [on]
children Exp_
x


descendApps :: (Exp_ -> Exp_) -> Exp_ -> Exp_
descendApps :: (Exp_ -> Exp_) -> Exp_ -> Exp_
descendApps f :: Exp_ -> Exp_
f (App s :: S
s x :: Exp_
x y :: Exp_
y) = S -> Exp_ -> Exp_ -> Exp_
forall l. l -> Exp l -> Exp l -> Exp l
App S
s ((Exp_ -> Exp_) -> Exp_ -> Exp_
descendApps Exp_ -> Exp_
f Exp_
x) (Exp_ -> Exp_
f Exp_
y)
descendApps f :: Exp_ -> Exp_
f x :: Exp_
x = (Exp_ -> Exp_) -> Exp_ -> Exp_
forall on. Uniplate on => (on -> on) -> on -> on
descend Exp_ -> Exp_
f Exp_
x


descendAppsM :: Monad m => (Exp_ -> m Exp_) -> Exp_ -> m Exp_
descendAppsM :: (Exp_ -> m Exp_) -> Exp_ -> m Exp_
descendAppsM f :: Exp_ -> m Exp_
f (App s :: S
s x :: Exp_
x y :: Exp_
y) = (Exp_ -> Exp_ -> Exp_) -> m Exp_ -> m Exp_ -> m Exp_
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (S -> Exp_ -> Exp_ -> Exp_
forall l. l -> Exp l -> Exp l -> Exp l
App S
s) ((Exp_ -> m Exp_) -> Exp_ -> m Exp_
forall (m :: * -> *). Monad m => (Exp_ -> m Exp_) -> Exp_ -> m Exp_
descendAppsM Exp_ -> m Exp_
f Exp_
x) (Exp_ -> m Exp_
f Exp_
y)
descendAppsM f :: Exp_ -> m Exp_
f x :: Exp_
x = (Exp_ -> m Exp_) -> Exp_ -> m Exp_
forall on (m :: * -> *).
(Uniplate on, Monad m) =>
(on -> m on) -> on -> m on
descendM Exp_ -> m Exp_
f Exp_
x


universeApps :: Exp_ -> [Exp_]
universeApps :: Exp_ -> [Exp_]
universeApps x :: Exp_
x = Exp_
x Exp_ -> [Exp_] -> [Exp_]
forall a. a -> [a] -> [a]
: (Exp_ -> [Exp_]) -> [Exp_] -> [Exp_]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Exp_ -> [Exp_]
universeApps (Exp_ -> [Exp_]
childrenApps Exp_
x)

transformApps :: (Exp_ -> Exp_) -> Exp_ -> Exp_
transformApps :: (Exp_ -> Exp_) -> Exp_ -> Exp_
transformApps f :: Exp_ -> Exp_
f = Exp_ -> Exp_
f (Exp_ -> Exp_) -> (Exp_ -> Exp_) -> Exp_ -> Exp_
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Exp_ -> Exp_) -> Exp_ -> Exp_
descendApps ((Exp_ -> Exp_) -> Exp_ -> Exp_
transformApps Exp_ -> Exp_
f)

transformAppsM :: Monad m => (Exp_ -> m Exp_) -> Exp_ -> m Exp_
transformAppsM :: (Exp_ -> m Exp_) -> Exp_ -> m Exp_
transformAppsM f :: Exp_ -> m Exp_
f x :: Exp_
x = Exp_ -> m Exp_
f (Exp_ -> m Exp_) -> m Exp_ -> m Exp_
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Exp_ -> m Exp_) -> Exp_ -> m Exp_
forall (m :: * -> *). Monad m => (Exp_ -> m Exp_) -> Exp_ -> m Exp_
descendAppsM ((Exp_ -> m Exp_) -> Exp_ -> m Exp_
forall (m :: * -> *). Monad m => (Exp_ -> m Exp_) -> Exp_ -> m Exp_
transformAppsM Exp_ -> m Exp_
f) Exp_
x


---------------------------------------------------------------------
-- UNIPLATE FUNCTIONS

universeS :: (Data x, Data (f S)) => x -> [f S]
universeS :: x -> [f S]
universeS = x -> [f S]
forall from to. Biplate from to => from -> [to]
universeBi

childrenS :: (Data x, Data (f S)) => x -> [f S]
childrenS :: x -> [f S]
childrenS = x -> [f S]
forall from to. Biplate from to => from -> [to]
childrenBi


-- return the parent along with the child
universeParentExp :: Data a => a -> [(Maybe (Int, Exp_), Exp_)]
universeParentExp :: a -> [(Maybe (Int, Exp_), Exp_)]
universeParentExp xs :: a
xs = [[(Maybe (Int, Exp_), Exp_)]] -> [(Maybe (Int, Exp_), Exp_)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(Maybe (Int, Exp_)
forall a. Maybe a
Nothing, Exp_
x) (Maybe (Int, Exp_), Exp_)
-> [(Maybe (Int, Exp_), Exp_)] -> [(Maybe (Int, Exp_), Exp_)]
forall a. a -> [a] -> [a]
: Exp_ -> [(Maybe (Int, Exp_), Exp_)]
forall a t. (Num a, Enum a, Data t) => t -> [(Maybe (a, t), t)]
f Exp_
x | Exp_
x <- a -> [Exp_]
forall from to. Biplate from to => from -> [to]
childrenBi a
xs]
    where f :: t -> [(Maybe (a, t), t)]
f p :: t
p = [[(Maybe (a, t), t)]] -> [(Maybe (a, t), t)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [((a, t) -> Maybe (a, t)
forall a. a -> Maybe a
Just (a
i,t
p), t
c) (Maybe (a, t), t) -> [(Maybe (a, t), t)] -> [(Maybe (a, t), t)]
forall a. a -> [a] -> [a]
: t -> [(Maybe (a, t), t)]
f t
c | (i :: a
i,c :: t
c) <- [a] -> [t] -> [(a, t)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] ([t] -> [(a, t)]) -> [t] -> [(a, t)]
forall a b. (a -> b) -> a -> b
$ t -> [t]
forall on. Uniplate on => on -> [on]
children t
p]


---------------------------------------------------------------------
-- SRCLOC FUNCTIONS

showSrcLoc :: SrcLoc -> String
showSrcLoc :: SrcLoc -> String
showSrcLoc (SrcLoc file :: String
file line :: Int
line col :: Int
col) = Int -> String -> String
forall a. Int -> [a] -> [a]
take 1 String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
f (Int -> String -> String
forall a. Int -> [a] -> [a]
drop 1 String
file) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col
    where f :: String -> String
f (x :: Char
x:y :: Char
y:zs :: String
zs) | Char -> Bool
isPathSeparator Char
x Bool -> Bool -> Bool
&& Char -> Bool
isPathSeparator Char
y = String -> String
f (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
zs
          f (x :: Char
x:xs :: String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
f String
xs
          f [] = []

an :: SrcSpanInfo
an :: S
an = S
forall a. Default a => a
def

dropAnn :: Functor f => f SrcSpanInfo -> f ()
dropAnn :: f S -> f ()
dropAnn = f S -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void

---------------------------------------------------------------------
-- SRCLOC EQUALITY

-- enforce all being on S, as otherwise easy to =~= on a Just, and get the wrong functor

x :: a l1
x /=~= :: a l1 -> a l2 -> Bool
/=~= y :: a l2
y = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ a l1
x a l1 -> a l2 -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= a l2
y

elem_, notElem_ :: (Annotated f, Eq (f ())) => f S -> [f S] -> Bool
elem_ :: f S -> [f S] -> Bool
elem_ x :: f S
x = (f S -> Bool) -> [f S] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (f S
x f S -> f S -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~=)
notElem_ :: f S -> [f S] -> Bool
notElem_ x :: f S
x = Bool -> Bool
not (Bool -> Bool) -> ([f S] -> Bool) -> [f S] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f S -> [f S] -> Bool
forall (f :: * -> *).
(Annotated f, Eq (f ())) =>
f S -> [f S] -> Bool
elem_ f S
x

nub_ :: (Annotated f, Eq (f ())) => [f S] -> [f S]
nub_ :: [f S] -> [f S]
nub_ = (f S -> f S -> Bool) -> [f S] -> [f S]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy f S -> f S -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
(=~=)

delete_ :: (Annotated f, Eq (f ())) => f S -> [f S] -> [f S]
delete_ :: f S -> [f S] -> [f S]
delete_ = (f S -> f S -> Bool) -> f S -> [f S] -> [f S]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy f S -> f S -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
(=~=)

intersect_ :: (Annotated f, Eq (f ())) => [f S] -> [f S] -> [f S]
intersect_ :: [f S] -> [f S] -> [f S]
intersect_ = (f S -> f S -> Bool) -> [f S] -> [f S] -> [f S]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
intersectBy f S -> f S -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
(=~=)

eqList, neqList :: (Annotated f, Eq (f ())) => [f S] -> [f S] -> Bool
neqList :: [f S] -> [f S] -> Bool
neqList x :: [f S]
x y :: [f S]
y = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [f S] -> [f S] -> Bool
forall (f :: * -> *).
(Annotated f, Eq (f ())) =>
[f S] -> [f S] -> Bool
eqList [f S]
x [f S]
y
eqList :: [f S] -> [f S] -> Bool
eqList (x :: f S
x:xs :: [f S]
xs) (y :: f S
y:ys :: [f S]
ys) = f S
x f S -> f S -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= f S
y Bool -> Bool -> Bool
&& [f S] -> [f S] -> Bool
forall (f :: * -> *).
(Annotated f, Eq (f ())) =>
[f S] -> [f S] -> Bool
eqList [f S]
xs [f S]
ys
eqList [] [] = Bool
True
eqList _ _ = Bool
False

eqMaybe:: (Annotated f, Eq (f ())) => Maybe (f S) -> Maybe (f S) -> Bool
eqMaybe :: Maybe (f S) -> Maybe (f S) -> Bool
eqMaybe (Just x :: f S
x) (Just y :: f S
y) = f S
x f S -> f S -> Bool
forall (a :: * -> *) l1 l2.
(Annotated a, Eq (a ())) =>
a l1 -> a l2 -> Bool
=~= f S
y
eqMaybe Nothing Nothing = Bool
True
eqMaybe _ _ = Bool
False


---------------------------------------------------------------------
-- FIXITIES

getFixity :: Decl a -> [Fixity]
getFixity :: Decl a -> [Fixity]
getFixity (InfixDecl sl :: a
sl a :: Assoc a
a mp :: Maybe Int
mp ops :: [Op a]
ops) = [Assoc () -> Int -> QName () -> Fixity
Fixity (Assoc a -> Assoc ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Assoc a
a) (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 9 Maybe Int
mp) (() -> Name () -> QName ()
forall l. l -> Name l -> QName l
UnQual () (Name () -> QName ()) -> Name () -> QName ()
forall a b. (a -> b) -> a -> b
$ Name a -> Name ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Name a -> Name ()) -> Name a -> Name ()
forall a b. (a -> b) -> a -> b
$ Op a -> Name a
forall l. Op l -> Name l
f Op a
op) | Op a
op <- [Op a]
ops]
    where f :: Op l -> Name l
f (VarOp _ x :: Name l
x) = Name l
x
          f (ConOp _ x :: Name l
x) = Name l
x
getFixity _ = []

toInfixDecl :: Fixity -> Decl ()
toInfixDecl :: Fixity -> Decl ()
toInfixDecl (Fixity a :: Assoc ()
a b :: Int
b c :: QName ()
c) = () -> Assoc () -> Maybe Int -> [Op ()] -> Decl ()
forall l. l -> Assoc l -> Maybe Int -> [Op l] -> Decl l
InfixDecl () Assoc ()
a (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
b) ([Op ()] -> Decl ()) -> [Op ()] -> Decl ()
forall a b. (a -> b) -> a -> b
$ Maybe (Op ()) -> [Op ()]
forall a. Maybe a -> [a]
maybeToList (Maybe (Op ()) -> [Op ()]) -> Maybe (Op ()) -> [Op ()]
forall a b. (a -> b) -> a -> b
$ () -> Name () -> Op ()
forall l. l -> Name l -> Op l
VarOp () (Name () -> Op ()) -> Maybe (Name ()) -> Maybe (Op ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName () -> Maybe (Name ())
forall a. QName a -> Maybe (Name a)
fromQual QName ()
c



-- | This extension implies the following extensions
extensionImplies :: Extension -> [Extension]
extensionImplies :: Extension -> [Extension]
extensionImplies = \x :: Extension
x -> [Extension]
-> Extension -> Map Extension [Extension] -> [Extension]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Extension
x Map Extension [Extension]
mp
    where mp :: Map Extension [Extension]
mp = [(Extension, [Extension])] -> Map Extension [Extension]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Extension, [Extension])]
extensionImplications

-- | This extension is implied by the following extensions
extensionImpliedBy :: Extension -> [Extension]
extensionImpliedBy :: Extension -> [Extension]
extensionImpliedBy = \x :: Extension
x -> [Extension]
-> Extension -> Map Extension [Extension] -> [Extension]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Extension
x Map Extension [Extension]
mp
    where mp :: Map Extension [Extension]
mp = ([Extension] -> [Extension] -> [Extension])
-> [(Extension, [Extension])] -> Map Extension [Extension]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
(++) [(Extension
b, [Extension
a]) | (a :: Extension
a,bs :: [Extension]
bs) <- [(Extension, [Extension])]
extensionImplications, Extension
b <- [Extension]
bs]

-- | (a, bs) means extension a implies all of bs.
--   Taken from https://downloads.haskell.org/~ghc/master/users-guide/glasgow_exts.html#language-options
--   In the GHC source at DynFlags.impliedXFlags
extensionImplications :: [(Extension, [Extension])]
extensionImplications :: [(Extension, [Extension])]
extensionImplications = ((KnownExtension, [Extension]) -> (Extension, [Extension]))
-> [(KnownExtension, [Extension])] -> [(Extension, [Extension])]
forall a b. (a -> b) -> [a] -> [b]
map ((KnownExtension -> Extension)
-> (KnownExtension, [Extension]) -> (Extension, [Extension])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first KnownExtension -> Extension
EnableExtension) ([(KnownExtension, [Extension])] -> [(Extension, [Extension])])
-> [(KnownExtension, [Extension])] -> [(Extension, [Extension])]
forall a b. (a -> b) -> a -> b
$
    (KnownExtension
RebindableSyntax, [KnownExtension -> Extension
DisableExtension KnownExtension
ImplicitPrelude]) (KnownExtension, [Extension])
-> [(KnownExtension, [Extension])]
-> [(KnownExtension, [Extension])]
forall a. a -> [a] -> [a]
:
    ((KnownExtension, [KnownExtension])
 -> (KnownExtension, [Extension]))
-> [(KnownExtension, [KnownExtension])]
-> [(KnownExtension, [Extension])]
forall a b. (a -> b) -> [a] -> [b]
map (([KnownExtension] -> [Extension])
-> (KnownExtension, [KnownExtension])
-> (KnownExtension, [Extension])
forall b b' a. (b -> b') -> (a, b) -> (a, b')
second ((KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
EnableExtension))
    [ (KnownExtension
DerivingVia              , [KnownExtension
DerivingStrategies])
    , (KnownExtension
RecordWildCards          , [KnownExtension
DisambiguateRecordFields])
    , (KnownExtension
ExistentialQuantification, [KnownExtension
ExplicitForAll])
    , (KnownExtension
FlexibleInstances        , [KnownExtension
TypeSynonymInstances])
    , (KnownExtension
FunctionalDependencies   , [KnownExtension
MultiParamTypeClasses])
    , (KnownExtension
GADTs                    , [KnownExtension
MonoLocalBinds])
    , (KnownExtension
IncoherentInstances      , [KnownExtension
OverlappingInstances])
--    Incorrect, see https://github.com/ndmitchell/hlint/issues/587
--    , (ImplicitParams           , [FlexibleContexts, FlexibleInstances])
    , (KnownExtension
ImpredicativeTypes       , [KnownExtension
ExplicitForAll, KnownExtension
RankNTypes])
    , (KnownExtension
LiberalTypeSynonyms      , [KnownExtension
ExplicitForAll])
    , (KnownExtension
PolyKinds                , [KnownExtension
KindSignatures])
    , (KnownExtension
RankNTypes               , [KnownExtension
ExplicitForAll])
    , (KnownExtension
ScopedTypeVariables      , [KnownExtension
ExplicitForAll])
    , (KnownExtension
TypeOperators            , [KnownExtension
ExplicitNamespaces])
    , (KnownExtension
TypeFamilies             , [KnownExtension
ExplicitNamespaces, KnownExtension
KindSignatures, KnownExtension
MonoLocalBinds])
    , (KnownExtension
TypeFamilyDependencies   , [KnownExtension
ExplicitNamespaces, KnownExtension
KindSignatures, KnownExtension
MonoLocalBinds, KnownExtension
TypeFamilies])
    ]