{-# LANGUAGE ViewPatterns, MultiParamTypeClasses, FlexibleInstances, PatternSynonyms #-}

module GHC.Util.View (
   fromParen
  , View(..)
  , RdrName_(RdrName_), Var_(Var_), PVar_(PVar_), PApp_(PApp_), App2(App2),LamConst1(LamConst1)
  , pattern SimpleLambda
) where

import GHC.Hs
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
import GHC.Types.Basic
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader
import GHC.Util.Brackets

fromParen :: LHsExpr GhcPs -> LHsExpr GhcPs
fromParen :: LHsExpr GhcPs -> LHsExpr GhcPs
fromParen LHsExpr GhcPs
x = LHsExpr GhcPs
-> (LHsExpr GhcPs -> LHsExpr GhcPs)
-> Maybe (LHsExpr GhcPs)
-> LHsExpr GhcPs
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LHsExpr GhcPs
x LHsExpr GhcPs -> LHsExpr GhcPs
fromParen (Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs)
-> Maybe (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> Maybe (LHsExpr GhcPs)
forall a. Brackets a => a -> Maybe a
remParen LHsExpr GhcPs
x

fromPParen :: LPat GhcPs -> LPat GhcPs
fromPParen :: LPat GhcPs -> LPat GhcPs
fromPParen (L _ (ParPat _ x)) = LPat GhcPs -> LPat GhcPs
fromPParen LPat GhcPs
x
fromPParen LPat GhcPs
x = LPat GhcPs
x

class View a b where
  view :: a -> b

data RdrName_ = NoRdrName_ | RdrName_ (Located RdrName)
data Var_  = NoVar_ | Var_ String deriving Var_ -> Var_ -> Bool
(Var_ -> Var_ -> Bool) -> (Var_ -> Var_ -> Bool) -> Eq Var_
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Var_ -> Var_ -> Bool
$c/= :: Var_ -> Var_ -> Bool
== :: Var_ -> Var_ -> Bool
$c== :: Var_ -> Var_ -> Bool
Eq
data PVar_ = NoPVar_ | PVar_ String
data PApp_ = NoPApp_ | PApp_ String [LPat GhcPs]
data App2  = NoApp2  | App2 (LHsExpr GhcPs) (LHsExpr GhcPs) (LHsExpr GhcPs)
data LamConst1 = NoLamConst1 | LamConst1 (LHsExpr GhcPs)

instance View (LHsExpr GhcPs) LamConst1 where
  view :: LHsExpr GhcPs -> LamConst1
view (LHsExpr GhcPs -> LHsExpr GhcPs
fromParen -> (L SrcSpan
_ (HsLam XLam GhcPs
_ (MG XMG GhcPs (LHsExpr GhcPs)
_ (L SrcSpan
_ [L SrcSpan
_ (Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext (NoGhcTc GhcPs)
LambdaExpr [L _ WildPat {}]
    (GRHSs XCGRHSs GhcPs (LHsExpr GhcPs)
_ [L SrcSpan
_ (GRHS XCGRHS GhcPs (LHsExpr GhcPs)
_ [] LHsExpr GhcPs
x)] (L SrcSpan
_ (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_))))]) Origin
FromSource)))) = LHsExpr GhcPs -> LamConst1
LamConst1 LHsExpr GhcPs
x
  view LHsExpr GhcPs
_ = LamConst1
NoLamConst1

instance View (LHsExpr GhcPs) RdrName_ where
    view :: LHsExpr GhcPs -> RdrName_
view (LHsExpr GhcPs -> LHsExpr GhcPs
fromParen -> (L SrcSpan
_ (HsVar XVar GhcPs
_ Located (IdP GhcPs)
name))) = Located RdrName -> RdrName_
RdrName_ Located (IdP GhcPs)
Located RdrName
name
    view LHsExpr GhcPs
_ = RdrName_
NoRdrName_

instance View (LHsExpr GhcPs) Var_ where
    view :: LHsExpr GhcPs -> Var_
view (LHsExpr GhcPs -> RdrName_
forall a b. View a b => a -> b
view -> RdrName_ Located RdrName
name) = String -> Var_
Var_ (Located RdrName -> String
rdrNameStr Located RdrName
name)
    view LHsExpr GhcPs
_ = Var_
NoVar_

instance View (LHsExpr GhcPs) App2 where
  view :: LHsExpr GhcPs -> App2
view (LHsExpr GhcPs -> LHsExpr GhcPs
fromParen -> L SrcSpan
_ (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
lhs LHsExpr GhcPs
op LHsExpr GhcPs
rhs)) = LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> App2
App2 LHsExpr GhcPs
op LHsExpr GhcPs
lhs LHsExpr GhcPs
rhs
  view (LHsExpr GhcPs -> LHsExpr GhcPs
fromParen -> L SrcSpan
_ (HsApp XApp GhcPs
_ (L SrcSpan
_ (HsApp XApp GhcPs
_ LHsExpr GhcPs
f LHsExpr GhcPs
x)) LHsExpr GhcPs
y)) = LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> App2
App2 LHsExpr GhcPs
f LHsExpr GhcPs
x LHsExpr GhcPs
y
  view LHsExpr GhcPs
_ = App2
NoApp2

instance View (Located (Pat GhcPs)) PVar_ where
  view :: Located (Pat GhcPs) -> PVar_
view (LPat GhcPs -> LPat GhcPs
Located (Pat GhcPs) -> LPat GhcPs
fromPParen -> L _ (VarPat _ (L _ x))) = String -> PVar_
PVar_ (String -> PVar_) -> String -> PVar_
forall a b. (a -> b) -> a -> b
$ RdrName -> String
occNameStr IdP GhcPs
RdrName
x
  view Located (Pat GhcPs)
_ = PVar_
NoPVar_

instance View (Located (Pat GhcPs)) PApp_ where
  view :: Located (Pat GhcPs) -> PApp_
view (LPat GhcPs -> LPat GhcPs
Located (Pat GhcPs) -> LPat GhcPs
fromPParen -> L _ (ConPat _ (L _ x) (PrefixCon args))) =
    String -> [LPat GhcPs] -> PApp_
PApp_ (RdrName -> String
occNameStr ConLikeP GhcPs
RdrName
x) [LPat GhcPs]
args
  view (LPat GhcPs -> LPat GhcPs
Located (Pat GhcPs) -> LPat GhcPs
fromPParen -> L _ (ConPat _ (L _ x) (InfixCon lhs rhs))) =
    String -> [LPat GhcPs] -> PApp_
PApp_ (RdrName -> String
occNameStr ConLikeP GhcPs
RdrName
x) [LPat GhcPs
lhs, LPat GhcPs
rhs]
  view Located (Pat GhcPs)
_ = PApp_
NoPApp_

-- A lambda with no guards and no where clauses
pattern SimpleLambda :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs
pattern $mSimpleLambda :: forall r.
LHsExpr GhcPs
-> ([LPat GhcPs] -> LHsExpr GhcPs -> r) -> (Void# -> r) -> r
SimpleLambda vs body <- L _ (HsLam _ (MG _ (L _ [L _ (Match _ _ vs (GRHSs _ [L _ (GRHS _ [] body)] (L _ (EmptyLocalBinds _))))]) _))