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

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

import GHC.Hs
import SrcLoc
import BasicTypes
import Language.Haskell.GhclibParserEx.GHC.Types.Name.Reader

fromParen :: LHsExpr GhcPs -> LHsExpr GhcPs
fromParen :: LHsExpr GhcPs -> LHsExpr GhcPs
fromParen (L SrcSpan
_ (HsPar XPar GhcPs
_ LHsExpr GhcPs
x)) = LHsExpr GhcPs -> LHsExpr GhcPs
fromParen LHsExpr GhcPs
x
fromParen LHsExpr GhcPs
x = 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 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 (NameOrRdrName (IdP 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) Var_ where
    view :: LHsExpr GhcPs -> Var_
view (LHsExpr GhcPs -> LHsExpr GhcPs
fromParen -> (L SrcSpan
_ (HsVar XVar GhcPs
_ (Located (IdP GhcPs) -> String
Located RdrName -> String
rdrNameStr -> String
x)))) = String -> Var_
Var_ String
x
    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 _ (ConPatIn (L _ x) (PrefixCon args))) =
    String -> [LPat GhcPs] -> PApp_
PApp_ (RdrName -> String
occNameStr IdP GhcPs
RdrName
x) [LPat GhcPs]
args
  view (LPat GhcPs -> LPat GhcPs
Located (Pat GhcPs) -> LPat GhcPs
fromPParen -> L _ (ConPatIn (L _ x) (InfixCon lhs rhs))) =
    String -> [LPat GhcPs] -> PApp_
PApp_ (RdrName -> String
occNameStr IdP 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 _))))]) _))