{-# 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
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 "..."
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 _ = []
moduleName :: Module_ -> String
moduleName :: Module_ -> String
moduleName (Module _ Nothing _ _ _) = "Main"
moduleName (Module _ (Just (ModuleHead _ (ModuleName _ x :: String
x) _ _)) _ _ _) = String
x
moduleName _ = ""
moduleImports :: Module_ -> [ImportDecl S]
moduleImports :: Module_ -> [ImportDecl S]
moduleImports (Module _ _ _ x :: [ImportDecl S]
x _) = [ImportDecl S]
x
moduleImports _ = []
modulePragmas :: Module_ -> [ModulePragma S]
modulePragmas :: Module_ -> [ModulePragma S]
modulePragmas (Module _ _ x :: [ModulePragma S]
x _ _) = [ModulePragma S]
x
modulePragmas _ = []
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
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
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
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
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)
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
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
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)
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)]
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
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
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]
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
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
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
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
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]
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])
, (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])
]