{-# 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 :: LocatedA (HsExpr GhcPs) -> LocatedA (HsExpr GhcPs)
fromParen :: LocatedA (HsExpr GhcPs) -> LocatedA (HsExpr GhcPs)
fromParen LocatedA (HsExpr GhcPs)
x = LocatedA (HsExpr GhcPs)
-> (LocatedA (HsExpr GhcPs) -> LocatedA (HsExpr GhcPs))
-> Maybe (LocatedA (HsExpr GhcPs))
-> LocatedA (HsExpr GhcPs)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe LocatedA (HsExpr GhcPs)
x LocatedA (HsExpr GhcPs) -> LocatedA (HsExpr GhcPs)
fromParen (Maybe (LocatedA (HsExpr GhcPs)) -> LocatedA (HsExpr GhcPs))
-> Maybe (LocatedA (HsExpr GhcPs)) -> LocatedA (HsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$ LocatedA (HsExpr GhcPs) -> Maybe (LocatedA (HsExpr GhcPs))
forall a. Brackets a => a -> Maybe a
remParen LocatedA (HsExpr GhcPs)
x

fromPParen :: LocatedA (Pat GhcPs) -> LocatedA (Pat GhcPs)
fromPParen :: LocatedA (Pat GhcPs) -> LocatedA (Pat GhcPs)
fromPParen (L SrcSpanAnnA
_ (ParPat XParPat GhcPs
_ LHsToken "(" GhcPs
_ LPat GhcPs
x LHsToken ")" GhcPs
_ )) = LocatedA (Pat GhcPs) -> LocatedA (Pat GhcPs)
fromPParen LPat GhcPs
LocatedA (Pat GhcPs)
x
fromPParen LocatedA (Pat GhcPs)
x = LocatedA (Pat GhcPs)
x

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

data RdrName_ = NoRdrName_ | RdrName_ (LocatedN 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
$c== :: Var_ -> Var_ -> Bool
== :: Var_ -> Var_ -> Bool
$c/= :: Var_ -> Var_ -> Bool
/= :: Var_ -> Var_ -> Bool
Eq
data PVar_ = NoPVar_ | PVar_ String
data PApp_ = NoPApp_ | PApp_ String [LocatedA (Pat GhcPs)]
data App2  = NoApp2  | App2 (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs))
data LamConst1 = NoLamConst1 | LamConst1 (LocatedA (HsExpr GhcPs))

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

instance View (LocatedA (HsExpr GhcPs)) RdrName_ where
    view :: LocatedA (HsExpr GhcPs) -> RdrName_
view (LocatedA (HsExpr GhcPs) -> LocatedA (HsExpr GhcPs)
fromParen -> (L SrcSpanAnnA
_ (HsVar XVar GhcPs
_ LIdP GhcPs
name))) = LocatedN RdrName -> RdrName_
RdrName_ LIdP GhcPs
LocatedN RdrName
name
    view LocatedA (HsExpr GhcPs)
_ = RdrName_
NoRdrName_

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

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

instance View (LocatedA (Pat GhcPs)) PVar_ where
  view :: LocatedA (Pat GhcPs) -> PVar_
view (LocatedA (Pat GhcPs) -> LocatedA (Pat GhcPs)
fromPParen -> L SrcSpanAnnA
_ (VarPat XVarPat GhcPs
_ (L SrcSpanAnnN
_ RdrName
x))) = String -> PVar_
PVar_ (String -> PVar_) -> String -> PVar_
forall a b. (a -> b) -> a -> b
$ RdrName -> String
occNameStr RdrName
x
  view LocatedA (Pat GhcPs)
_ = PVar_
NoPVar_

instance View (LocatedA (Pat GhcPs)) PApp_ where
  view :: LocatedA (Pat GhcPs) -> PApp_
view (LocatedA (Pat GhcPs) -> LocatedA (Pat GhcPs)
fromPParen -> L SrcSpanAnnA
_ (ConPat XConPat GhcPs
_ (L SrcSpanAnnN
_ RdrName
x) (PrefixCon [HsConPatTyArg (NoGhcTc GhcPs)]
_ [LPat GhcPs]
args))) =
    String -> [LocatedA (Pat GhcPs)] -> PApp_
PApp_ (RdrName -> String
occNameStr RdrName
x) [LPat GhcPs]
[LocatedA (Pat GhcPs)]
args
  view (LocatedA (Pat GhcPs) -> LocatedA (Pat GhcPs)
fromPParen -> L SrcSpanAnnA
_ (ConPat XConPat GhcPs
_ (L SrcSpanAnnN
_ RdrName
x) (InfixCon LPat GhcPs
lhs LPat GhcPs
rhs))) =
    String -> [LocatedA (Pat GhcPs)] -> PApp_
PApp_ (RdrName -> String
occNameStr RdrName
x) [LPat GhcPs
LocatedA (Pat GhcPs)
lhs, LPat GhcPs
LocatedA (Pat GhcPs)
rhs]
  view LocatedA (Pat GhcPs)
_ = PApp_
NoPApp_

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