Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
523 lines (454 sloc) 24.1 KB
-----------------------------------------------------------------------------
-- |
-- Module : Language.Haskell.Exts.Annotated.Simplify
-- Copyright : (c) Niklas Broberg 2009
-- License : BSD-style (see the file LICENSE.txt)
--
-- Maintainer : Niklas Broberg, d00nibro@chalmers.se
-- Stability : experimental
-- Portability : portable
--
-- This module contains code for translating from the annotated
-- complex AST in Language.Haskell.Exts.Annotated.Syntax
-- to the simpler, sparsely annotated AST in Language.Haskell.Exts.Syntax.
--
-- A function @sXYZ@ translates an annotated AST node of type @XYZ l@ into
-- a simple AST node of type @XYZ@. I would have prefered to use a MPTC
-- with an fd/type family to get a single exported function name, but
-- I wish to stay Haskell 2010 compliant. Let's hope for Haskell 2011.
--
-----------------------------------------------------------------------------
module Language.Haskell.Exts.Annotated.Simplify where
import Language.Haskell.Exts.Annotated.Syntax
import qualified Language.Haskell.Exts.Syntax as S
import Language.Haskell.Exts.SrcLoc
-- | Translate an annotated AST node representing a Haskell module, into
-- a simpler version that retains (almost) only abstract information.
-- In particular, XML and hybrid XML pages enabled by the XmlSyntax extension
-- are translated into standard Haskell modules with a @page@ function.
sModule :: SrcInfo loc => Module loc -> S.Module
sModule md = case md of
Module l mmh oss ids ds ->
let (mn, mwt, mes) = sModuleHead mmh
in S.Module (getPointLoc l) mn (map sModulePragma oss) mwt mes (map sImportDecl ids) (map sDecl ds)
XmlPage l mn oss xn attrs mat es ->
let loc = getPointLoc l
in S.Module loc (sModuleName mn) (map sModulePragma oss)
Nothing
(Just [S.EVar $ S.UnQual $ S.Ident "page"])
[]
[pageFun loc $ S.XTag loc (sXName xn) (map sXAttr attrs) (fmap sExp mat) (map sExp es)]
XmlHybrid l mmh oss ids ds xn attrs mat es ->
let loc1 = getPointLoc l
loc2 = getPointLoc (ann xn)
(mn, mwt, mes) = sModuleHead mmh
in S.Module loc1 mn (map sModulePragma oss) mwt mes (map sImportDecl ids)
(map sDecl ds ++ [pageFun loc2 $ S.XTag loc2 (sXName xn) (map sXAttr attrs) (fmap sExp mat) (map sExp es)])
where pageFun :: SrcLoc -> S.Exp -> S.Decl
pageFun loc e = S.PatBind loc namePat Nothing rhs (S.BDecls [])
where namePat = S.PVar $ S.Ident "page"
rhs = S.UnGuardedRhs e
-- | Translate an annotated AST node representing a Haskell declaration
-- into a simpler version. Note that in the simpler version, all declaration
-- nodes are still annotated by 'SrcLoc's.
sDecl :: SrcInfo loc => Decl loc -> S.Decl
sDecl decl = case decl of
TypeDecl l dh t ->
let (n, tvs) = sDeclHead dh
in S.TypeDecl (getPointLoc l) n tvs (sType t)
TypeFamDecl l dh mk ->
let (n, tvs) = sDeclHead dh
in S.TypeFamDecl (getPointLoc l) n tvs (fmap sKind mk)
DataDecl l dn mctxt dh constrs mder ->
let (n, tvs) = sDeclHead dh
in S.DataDecl (getPointLoc l) (sDataOrNew dn) (maybe [] sContext mctxt) n tvs (map sQualConDecl constrs) (maybe [] sDeriving mder)
GDataDecl l dn mctxt dh mk gds mder ->
let (n, tvs) = sDeclHead dh
in S.GDataDecl (getPointLoc l) (sDataOrNew dn) (maybe [] sContext mctxt) n tvs (fmap sKind mk) (map sGadtDecl gds) (maybe [] sDeriving mder)
DataFamDecl l mctxt dh mk ->
let (n, tvs) = sDeclHead dh
in S.DataFamDecl (getPointLoc l) (maybe [] sContext mctxt) n tvs (fmap sKind mk)
TypeInsDecl l t1 t2 -> S.TypeInsDecl (getPointLoc l) (sType t1) (sType t2)
DataInsDecl l dn t constrs mder ->
S.DataInsDecl (getPointLoc l) (sDataOrNew dn) (sType t) (map sQualConDecl constrs) (maybe [] sDeriving mder)
GDataInsDecl l dn t mk gds mder ->
S.GDataInsDecl (getPointLoc l) (sDataOrNew dn) (sType t) (fmap sKind mk) (map sGadtDecl gds) (maybe [] sDeriving mder)
ClassDecl l mctxt dh fds mcds ->
let (n, tvs) = sDeclHead dh
in S.ClassDecl (getPointLoc l) (maybe [] sContext mctxt) n tvs (map sFunDep fds) (maybe [] (map sClassDecl) mcds)
InstDecl l mctxt ih mids ->
let (qn, ts) = sInstHead ih
in S.InstDecl (getPointLoc l) (maybe [] sContext mctxt) qn ts (maybe [] (map sInstDecl) mids)
DerivDecl l mctxt ih ->
let (qn, ts) = sInstHead ih
in S.DerivDecl (getPointLoc l) (maybe [] sContext mctxt) qn ts
InfixDecl l ass prec ops -> S.InfixDecl (getPointLoc l) (sAssoc ass) (maybe 9 id prec) (map sOp ops)
DefaultDecl l ts -> S.DefaultDecl (getPointLoc l) (map sType ts)
SpliceDecl l sp -> S.SpliceDecl (getPointLoc l) (sExp sp)
TypeSig l ns t -> S.TypeSig (getPointLoc l) (map sName ns) (sType t)
FunBind _ ms -> S.FunBind (map sMatch ms)
PatBind l p mt rhs mbs ->
S.PatBind (getPointLoc l) (sPat p) (fmap sType mt) (sRhs rhs) (maybe (S.BDecls []) sBinds mbs)
ForImp l cc msaf mstr n t ->
S.ForImp (getPointLoc l) (sCallConv cc) (maybe (S.PlaySafe False) sSafety msaf) (maybe "" id mstr) (sName n) (sType t)
ForExp l cc mstr n t ->
S.ForExp (getPointLoc l) (sCallConv cc) (maybe "" id mstr) (sName n) (sType t)
RulePragmaDecl l rs -> S.RulePragmaDecl (getPointLoc l) (map sRule rs)
DeprPragmaDecl l nsstrs -> S.DeprPragmaDecl (getPointLoc l) (map (\(ns, str) -> (map sName ns, str)) nsstrs)
WarnPragmaDecl l nsstrs -> S.WarnPragmaDecl (getPointLoc l) (map (\(ns, str) -> (map sName ns, str)) nsstrs)
InlineSig l b mact qn -> S.InlineSig (getPointLoc l) b (maybe S.AlwaysActive sActivation mact) (sQName qn)
InlineConlikeSig l mact qn -> S.InlineConlikeSig (getPointLoc l) (maybe S.AlwaysActive sActivation mact) (sQName qn)
SpecSig l qn ts -> S.SpecSig (getPointLoc l) (sQName qn) (map sType ts)
SpecInlineSig l b mact qn ts ->
S.SpecInlineSig (getPointLoc l) b (maybe S.AlwaysActive sActivation mact) (sQName qn) (map sType ts)
InstSig l mctxt ih ->
let (qn, ts) = sInstHead ih
in S.InstSig (getPointLoc l) (maybe [] sContext mctxt) qn ts
AnnPragma l ann ->
S.AnnPragma (getPointLoc l) (sAnnotation ann)
sAnnotation :: SrcInfo loc => Annotation loc -> S.Annotation
sAnnotation ann = case ann of
Ann _ n e -> S.Ann (sName n) (sExp e)
TypeAnn _ n e -> S.TypeAnn (sName n) (sExp e)
ModuleAnn _ e -> S.ModuleAnn (sExp e)
sModuleName :: ModuleName l -> S.ModuleName
sModuleName (ModuleName _ str) = S.ModuleName str
sSpecialCon :: SpecialCon l -> S.SpecialCon
sSpecialCon sc = case sc of
UnitCon _ -> S.UnitCon
ListCon _ -> S.ListCon
FunCon _ -> S.FunCon
TupleCon _ b k -> S.TupleCon b k
Cons _ -> S.Cons
UnboxedSingleCon _ -> S.UnboxedSingleCon
sQName :: QName l -> S.QName
sQName qn = case qn of
Qual _ mn n -> S.Qual (sModuleName mn) (sName n)
UnQual _ n -> S.UnQual (sName n)
Special _ sc -> S.Special (sSpecialCon sc)
sName :: Name l -> S.Name
sName (Ident _ str) = S.Ident str
sName (Symbol _ str) = S.Symbol str
sIPName :: IPName l -> S.IPName
sIPName (IPDup _ str) = S.IPDup str
sIPName (IPLin _ str) = S.IPLin str
sQOp :: QOp l -> S.QOp
sQOp (QVarOp _ qn) = S.QVarOp (sQName qn)
sQOp (QConOp _ qn) = S.QConOp (sQName qn)
sOp :: Op l -> S.Op
sOp (VarOp _ n) = S.VarOp (sName n)
sOp (ConOp _ n) = S.ConOp (sName n)
sCName :: CName l -> S.CName
sCName (VarName _ n) = S.VarName (sName n)
sCName (ConName _ n) = S.ConName (sName n)
sModuleHead :: Maybe (ModuleHead l) -> (S.ModuleName, Maybe (S.WarningText), Maybe [S.ExportSpec])
sModuleHead mmh = case mmh of
Nothing -> (S.main_mod, Nothing, Just [S.EVar (S.UnQual S.main_name)])
Just (ModuleHead _ mn mwt mel) -> (sModuleName mn, fmap sWarningText mwt, fmap sExportSpecList mel)
sExportSpecList :: ExportSpecList l -> [S.ExportSpec]
sExportSpecList (ExportSpecList _ ess) = map sExportSpec ess
sExportSpec :: ExportSpec l -> S.ExportSpec
sExportSpec es = case es of
EVar _ qn -> S.EVar (sQName qn)
EAbs _ qn -> S.EAbs (sQName qn)
EThingAll _ qn -> S.EThingAll (sQName qn)
EThingWith _ qn cns -> S.EThingWith (sQName qn) (map sCName cns)
EModuleContents _ mn -> S.EModuleContents (sModuleName mn)
EInstance _ c t -> S.EInstance (sQName c) (sQName t)
sImportDecl :: SrcInfo loc => ImportDecl loc -> S.ImportDecl
sImportDecl (ImportDecl l mn qu src mpkg as misl) =
S.ImportDecl (getPointLoc l) (sModuleName mn) qu src mpkg (fmap sModuleName as) (fmap sImportSpecList misl)
sImportSpecList :: ImportSpecList l -> (Bool, [S.ImportSpec])
sImportSpecList (ImportSpecList _ b iss) = (b, map sImportSpec iss)
sImportSpec :: ImportSpec l -> S.ImportSpec
sImportSpec is = case is of
IVar _ n -> S.IVar (sName n)
IAbs _ n -> S.IAbs (sName n)
IThingAll _ n -> S.IThingAll (sName n)
IThingWith _ n cns -> S.IThingWith (sName n) (map sCName cns)
IInstance _ c t -> S.IInstance (sName c) (sName t)
sAssoc :: Assoc l -> S.Assoc
sAssoc a = case a of
AssocNone _ -> S.AssocNone
AssocLeft _ -> S.AssocLeft
AssocRight _ -> S.AssocRight
sDeclHead :: DeclHead l -> (S.Name, [S.TyVarBind])
sDeclHead dh = case dh of
DHead _ n tvs -> (sName n, map sTyVarBind tvs)
DHInfix _ tva n tvb -> (sName n, map sTyVarBind [tva,tvb])
DHParen _ dh -> sDeclHead dh
sInstHead :: InstHead l -> (S.QName, [S.Type])
sInstHead ih = case ih of
IHead _ qn ts -> (sQName qn, map sType ts)
IHInfix _ ta qn tb -> (sQName qn, map sType [ta,tb])
IHParen _ ih -> sInstHead ih
sDataOrNew :: DataOrNew l -> S.DataOrNew
sDataOrNew (DataType _) = S.DataType
sDataOrNew (NewType _) = S.NewType
sDeriving :: (Deriving l) -> [(S.QName, [S.Type])]
sDeriving (Deriving _ ihs) = map sInstHead ihs
sBinds :: SrcInfo loc => Binds loc -> S.Binds
sBinds bs = case bs of
BDecls _ decls -> S.BDecls (map sDecl decls)
IPBinds _ ipbds -> S.IPBinds (map sIPBind ipbds)
sIPBind :: SrcInfo loc => IPBind loc -> S.IPBind
sIPBind (IPBind l ipn e) = S.IPBind (getPointLoc l) (sIPName ipn) (sExp e)
sMatch :: SrcInfo loc => Match loc -> S.Match
sMatch (Match l n ps rhs mwhere) =
S.Match (getPointLoc l) (sName n) (map sPat ps) Nothing (sRhs rhs) (maybe (S.BDecls []) sBinds mwhere)
sMatch (InfixMatch l pa n pbs rhs mwhere) =
S.Match (getPointLoc l) (sName n) (map sPat (pa:pbs)) Nothing (sRhs rhs) (maybe (S.BDecls []) sBinds mwhere)
sQualConDecl :: SrcInfo loc => QualConDecl loc -> S.QualConDecl
sQualConDecl (QualConDecl l mtvs mctxt cd) =
S.QualConDecl (getPointLoc l) (maybe [] (map sTyVarBind) mtvs) (maybe [] sContext mctxt) (sConDecl cd)
sConDecl :: ConDecl l -> S.ConDecl
sConDecl cd = case cd of
ConDecl _ n bts -> S.ConDecl (sName n) (map sBangType bts)
InfixConDecl _ bta n btb -> S.InfixConDecl (sBangType bta) (sName n) (sBangType btb)
RecDecl _ n fds -> S.RecDecl (sName n) (map sFieldDecl fds)
sFieldDecl :: FieldDecl l -> ([S.Name], S.BangType)
sFieldDecl (FieldDecl _ ns bt) = (map sName ns, sBangType bt)
sGadtDecl :: SrcInfo loc => GadtDecl loc -> S.GadtDecl
sGadtDecl (GadtDecl l n t) = S.GadtDecl (getPointLoc l) (sName n) (sType t)
sClassDecl :: SrcInfo loc => ClassDecl loc -> S.ClassDecl
sClassDecl cd = case cd of
ClsDecl _ d -> S.ClsDecl (sDecl d)
ClsDataFam l mctxt dh mk ->
let (n, tvs) = sDeclHead dh
in S.ClsDataFam (getPointLoc l) (maybe [] sContext mctxt) n tvs (fmap sKind mk)
ClsTyFam l dh mk ->
let (n, tvs) = sDeclHead dh
in S.ClsTyFam (getPointLoc l) n tvs (fmap sKind mk)
ClsTyDef l t1 t2 ->
S.ClsTyDef (getPointLoc l) (sType t1) (sType t2)
sInstDecl :: SrcInfo loc => InstDecl loc -> S.InstDecl
sInstDecl id = case id of
InsDecl _ d -> S.InsDecl (sDecl d)
InsType l t1 t2 -> S.InsType (getPointLoc l) (sType t1) (sType t2)
InsData l dn t constrs mder ->
S.InsData (getPointLoc l) (sDataOrNew dn) (sType t) (map sQualConDecl constrs) (maybe [] sDeriving mder)
InsGData l dn t mk gds mder ->
S.InsGData (getPointLoc l) (sDataOrNew dn) (sType t) (fmap sKind mk) (map sGadtDecl gds) (maybe [] sDeriving mder)
-- InsInline l b mact qn -> S.InsInline (getPointLoc l) b (maybe S.AlwaysActive sActivation mact) (sQName qn)
sBangType :: BangType l -> S.BangType
sBangType bt = case bt of
BangedTy _ t -> S.BangedTy (sType t)
UnBangedTy _ t -> S.UnBangedTy (sType t)
UnpackedTy _ t -> S.UnpackedTy (sType t)
sRhs :: SrcInfo loc => Rhs loc -> S.Rhs
sRhs (UnGuardedRhs _ e) = S.UnGuardedRhs (sExp e)
sRhs (GuardedRhss _ grhss) = S.GuardedRhss (map sGuardedRhs grhss)
sGuardedRhs :: SrcInfo loc => GuardedRhs loc -> S.GuardedRhs
sGuardedRhs (GuardedRhs l ss e) = S.GuardedRhs (getPointLoc l) (map sStmt ss) (sExp e)
sType :: Type l -> S.Type
sType t = case t of
TyForall _ mtvs mctxt t -> S.TyForall (fmap (map sTyVarBind) mtvs) (maybe [] sContext mctxt) (sType t)
TyFun _ t1 t2 -> S.TyFun (sType t1) (sType t2)
TyTuple _ bx ts -> S.TyTuple bx (map sType ts)
TyList _ t -> S.TyList (sType t)
TyApp _ t1 t2 -> S.TyApp (sType t1) (sType t2)
TyVar _ n -> S.TyVar (sName n)
TyCon _ qn -> S.TyCon (sQName qn)
TyParen _ t -> S.TyParen (sType t)
TyInfix _ ta qn tb -> S.TyInfix (sType ta) (sQName qn) (sType tb)
TyKind _ t k -> S.TyKind (sType t) (sKind k)
sTyVarBind :: TyVarBind l -> S.TyVarBind
sTyVarBind (KindedVar _ n k) = S.KindedVar (sName n) (sKind k)
sTyVarBind (UnkindedVar _ n) = S.UnkindedVar (sName n)
sKind :: Kind l -> S.Kind
sKind k = case k of
KindStar _ -> S.KindStar
KindBang _ -> S.KindBang
KindFn _ k1 k2 -> S.KindFn (sKind k1) (sKind k2)
KindParen _ k -> S.KindParen (sKind k)
KindVar _ n -> S.KindVar (sName n)
sFunDep :: FunDep l -> S.FunDep
sFunDep (FunDep _ as bs) = S.FunDep (map sName as) (map sName bs)
sContext :: Context l -> S.Context
sContext ctxt = case ctxt of
CxSingle _ asst -> [sAsst asst]
CxTuple _ assts -> map sAsst assts
CxParen _ ct -> sContext ct
CxEmpty _ -> []
sAsst :: Asst l -> S.Asst
sAsst asst = case asst of
ClassA _ qn ts -> S.ClassA (sQName qn) (map sType ts)
InfixA _ ta qn tb -> S.InfixA (sType ta) (sQName qn) (sType tb)
IParam _ ipn t -> S.IParam (sIPName ipn) (sType t)
EqualP _ t1 t2 -> S.EqualP (sType t1) (sType t2)
sLiteral :: Literal l -> S.Literal
sLiteral lit = case lit of
Char _ c _ -> S.Char c
String _ s _ -> S.String s
Int _ i _ -> S.Int i
Frac _ r _ -> S.Frac r
PrimInt _ i _ -> S.PrimInt i
PrimWord _ i _ -> S.PrimWord i
PrimFloat _ r _ -> S.PrimFloat r
PrimDouble _ r _ -> S.PrimDouble r
PrimChar _ c _ -> S.PrimChar c
PrimString _ s _ -> S.PrimString s
sExp :: SrcInfo loc => Exp loc -> S.Exp
sExp e = case e of
Var _ qn -> S.Var (sQName qn)
IPVar _ ipn -> S.IPVar (sIPName ipn)
Con _ qn -> S.Con (sQName qn)
Lit _ lit -> S.Lit (sLiteral lit)
InfixApp _ e1 op e2 -> S.InfixApp (sExp e1) (sQOp op) (sExp e2)
App _ e1 e2 -> S.App (sExp e1) (sExp e2)
NegApp _ e -> S.NegApp (sExp e)
Lambda l ps e -> S.Lambda (getPointLoc l) (map sPat ps) (sExp e)
Let _ bs e -> S.Let (sBinds bs) (sExp e)
If _ e1 e2 e3 -> S.If (sExp e1) (sExp e2) (sExp e3)
Case _ e alts -> S.Case (sExp e) (map sAlt alts)
Do _ ss -> S.Do (map sStmt ss)
MDo _ ss -> S.MDo (map sStmt ss)
Tuple _ es -> S.Tuple (map sExp es)
TupleSection _ mes -> S.TupleSection (map (fmap sExp) mes)
List _ es -> S.List (map sExp es)
Paren _ e -> S.Paren (sExp e)
LeftSection _ e op -> S.LeftSection (sExp e) (sQOp op)
RightSection _ op e -> S.RightSection (sQOp op) (sExp e)
RecConstr _ qn fups -> S.RecConstr (sQName qn) (map sFieldUpdate fups)
RecUpdate _ e fups -> S.RecUpdate (sExp e) (map sFieldUpdate fups)
EnumFrom _ e -> S.EnumFrom (sExp e)
EnumFromTo _ e1 e2 -> S.EnumFromTo (sExp e1) (sExp e2)
EnumFromThen _ e1 e2 -> S.EnumFromThen (sExp e1) (sExp e2)
EnumFromThenTo _ e1 e2 e3 -> S.EnumFromThenTo (sExp e1) (sExp e2) (sExp e3)
ListComp _ e qss -> S.ListComp (sExp e) (map sQualStmt qss)
ParComp _ e qsss -> S.ParComp (sExp e) (map (map sQualStmt) qsss)
ExpTypeSig l e t -> S.ExpTypeSig (getPointLoc l) (sExp e) (sType t)
VarQuote _ qn -> S.VarQuote (sQName qn)
TypQuote _ qn -> S.TypQuote (sQName qn)
BracketExp _ br -> S.BracketExp (sBracket br)
SpliceExp _ sp -> S.SpliceExp (sSplice sp)
QuasiQuote _ nm qt -> S.QuasiQuote nm qt
XTag l xn attrs mat es -> S.XTag (getPointLoc l) (sXName xn) (map sXAttr attrs) (fmap sExp mat) (map sExp es)
XETag l xn attrs mat -> S.XETag (getPointLoc l) (sXName xn) (map sXAttr attrs) (fmap sExp mat)
XPcdata _ str -> S.XPcdata str
XExpTag _ e -> S.XExpTag (sExp e)
XChildTag l es -> S.XChildTag (getPointLoc l) (map sExp es)
CorePragma _ str e -> S.CorePragma str (sExp e)
SCCPragma _ str e -> S.SCCPragma str (sExp e)
GenPragma _ str i12 i34 e -> S.GenPragma str i12 i34 (sExp e)
Proc l p e -> S.Proc (getPointLoc l) (sPat p) (sExp e)
LeftArrApp _ e1 e2 -> S.LeftArrApp (sExp e1) (sExp e2)
RightArrApp _ e1 e2 -> S.RightArrApp (sExp e1) (sExp e2)
LeftArrHighApp _ e1 e2 -> S.LeftArrHighApp (sExp e1) (sExp e2)
RightArrHighApp _ e1 e2 -> S.RightArrHighApp (sExp e1) (sExp e2)
sXName :: XName l -> S.XName
sXName (XName _ str) = S.XName str
sXName (XDomName _ dom str) = S.XDomName dom str
sXAttr :: SrcInfo loc => XAttr loc -> S.XAttr
sXAttr (XAttr _ xn e) = S.XAttr (sXName xn) (sExp e)
sBracket:: SrcInfo loc => Bracket loc -> S.Bracket
sBracket br = case br of
ExpBracket _ e -> S.ExpBracket (sExp e)
PatBracket _ p -> S.PatBracket (sPat p)
TypeBracket _ t -> S.TypeBracket (sType t)
DeclBracket _ ds -> S.DeclBracket (map sDecl ds)
sSplice :: SrcInfo loc => Splice loc -> S.Splice
sSplice (IdSplice _ str) = S.IdSplice str
sSplice (ParenSplice _ e) = S.ParenSplice (sExp e)
sSafety :: Safety l -> S.Safety
sSafety (PlayRisky _) = S.PlayRisky
sSafety (PlaySafe _ b) = S.PlaySafe b
sCallConv :: CallConv l -> S.CallConv
sCallConv (StdCall _) = S.StdCall
sCallConv (CCall _) = S.CCall
sModulePragma :: SrcInfo loc => ModulePragma loc -> S.ModulePragma
sModulePragma pr = case pr of
LanguagePragma l ns -> S.LanguagePragma (getPointLoc l) (map sName ns)
OptionsPragma l mt str -> S.OptionsPragma (getPointLoc l) mt str
AnnModulePragma l ann -> S.AnnModulePragma (getPointLoc l) (sAnnotation ann)
sActivation :: Activation l -> S.Activation
sActivation act = case act of
ActiveFrom _ k -> S.ActiveFrom k
ActiveUntil _ k -> S.ActiveUntil k
sRule :: SrcInfo loc => Rule loc -> S.Rule
sRule (Rule _ str mact mrvs e1 e2) =
S.Rule str (maybe S.AlwaysActive sActivation mact) (fmap (map sRuleVar) mrvs) (sExp e1) (sExp e2)
sRuleVar :: RuleVar l -> S.RuleVar
sRuleVar (RuleVar _ n) = S.RuleVar (sName n)
sRuleVar (TypedRuleVar _ n t) = S.TypedRuleVar (sName n) (sType t)
sWarningText :: WarningText l -> S.WarningText
sWarningText (DeprText _ str) = S.DeprText str
sWarningText (WarnText _ str) = S.WarnText str
sPat :: SrcInfo loc => Pat loc -> S.Pat
sPat pat = case pat of
PVar _ n -> S.PVar (sName n)
PLit _ lit -> S.PLit (sLiteral lit)
PNeg _ p -> S.PNeg (sPat p)
PNPlusK _ n k -> S.PNPlusK (sName n) k
PInfixApp _ pa qn pb -> S.PInfixApp (sPat pa) (sQName qn) (sPat pb)
PApp _ qn ps -> S.PApp (sQName qn) (map sPat ps)
PTuple _ ps -> S.PTuple (map sPat ps)
PList _ ps -> S.PList (map sPat ps)
PParen _ p -> S.PParen (sPat p)
PRec _ qn pfs -> S.PRec (sQName qn) (map sPatField pfs)
PAsPat _ n p -> S.PAsPat (sName n) (sPat p)
PWildCard _ -> S.PWildCard
PIrrPat _ p -> S.PIrrPat (sPat p)
PatTypeSig l p t -> S.PatTypeSig (getPointLoc l) (sPat p) (sType t)
PViewPat _ e p -> S.PViewPat (sExp e) (sPat p)
PRPat _ rps -> S.PRPat (map sRPat rps)
PXTag l xn attrs mat ps -> S.PXTag (getPointLoc l) (sXName xn) (map sPXAttr attrs) (fmap sPat mat) (map sPat ps)
PXETag l xn attrs mat -> S.PXETag (getPointLoc l) (sXName xn) (map sPXAttr attrs) (fmap sPat mat)
PXPcdata _ str -> S.PXPcdata str
PXPatTag _ p -> S.PXPatTag (sPat p)
PXRPats _ rps -> S.PXRPats (map sRPat rps)
PExplTypeArg _ qn t -> S.PExplTypeArg (sQName qn) (sType t)
PQuasiQuote _ nm qt -> S.PQuasiQuote nm qt
PBangPat _ p -> S.PBangPat (sPat p)
sPXAttr :: SrcInfo loc => PXAttr loc -> S.PXAttr
sPXAttr (PXAttr _ xn p) = S.PXAttr (sXName xn) (sPat p)
sRPatOp :: RPatOp l -> S.RPatOp
sRPatOp rpop = case rpop of
RPStar _ -> S.RPStar
RPStarG _ -> S.RPStarG
RPPlus _ -> S.RPPlus
RPPlusG _ -> S.RPPlusG
RPOpt _ -> S.RPOpt
RPOptG _ -> S.RPOptG
sRPat :: SrcInfo loc => RPat loc -> S.RPat
sRPat rp = case rp of
RPOp _ rp rop -> S.RPOp (sRPat rp) (sRPatOp rop)
RPEither _ rp1 rp2 -> S.RPEither (sRPat rp1) (sRPat rp2)
RPSeq _ rps -> S.RPSeq (map sRPat rps)
RPGuard _ p ss -> S.RPGuard (sPat p) (map sStmt ss)
RPCAs _ n rp -> S.RPCAs (sName n) (sRPat rp)
RPAs _ n rp -> S.RPAs (sName n) (sRPat rp)
RPParen _ rp -> S.RPParen (sRPat rp)
RPPat _ p -> S.RPPat (sPat p)
sPatField :: SrcInfo loc => PatField loc -> S.PatField
sPatField pf = case pf of
PFieldPat _ qn p -> S.PFieldPat (sQName qn) (sPat p)
PFieldPun _ n -> S.PFieldPun (sName n)
PFieldWildcard _ -> S.PFieldWildcard
sStmt :: SrcInfo loc => Stmt loc -> S.Stmt
sStmt stmt = case stmt of
Generator l p e -> S.Generator (getPointLoc l) (sPat p) (sExp e)
Qualifier _ e -> S.Qualifier (sExp e)
LetStmt _ bs -> S.LetStmt (sBinds bs)
RecStmt _ ss -> S.RecStmt (map sStmt ss)
sQualStmt :: SrcInfo loc => QualStmt loc -> S.QualStmt
sQualStmt qs = case qs of
QualStmt _ stmt -> S.QualStmt (sStmt stmt)
ThenTrans _ e -> S.ThenTrans (sExp e)
ThenBy _ e1 e2 -> S.ThenBy (sExp e1) (sExp e2)
GroupBy _ e -> S.GroupBy (sExp e)
GroupUsing _ e -> S.GroupUsing (sExp e)
GroupByUsing _ e1 e2 -> S.GroupByUsing (sExp e1) (sExp e2)
sFieldUpdate :: SrcInfo loc => FieldUpdate loc -> S.FieldUpdate
sFieldUpdate fu = case fu of
FieldUpdate _ qn e -> S.FieldUpdate (sQName qn) (sExp e)
FieldPun _ n -> S.FieldPun (sName n)
FieldWildcard _ -> S.FieldWildcard
sAlt :: SrcInfo loc => Alt loc -> S.Alt
sAlt (Alt l p galts mbs) = S.Alt (getPointLoc l) (sPat p) (sGuardedAlts galts) (maybe (S.BDecls []) sBinds mbs)
sGuardedAlts :: SrcInfo loc => GuardedAlts loc -> S.GuardedAlts
sGuardedAlts galts = case galts of
UnGuardedAlt _ e -> S.UnGuardedAlt (sExp e)
GuardedAlts _ gs -> S.GuardedAlts (map sGuardedAlt gs)
sGuardedAlt :: SrcInfo loc => GuardedAlt loc -> S.GuardedAlt
sGuardedAlt (GuardedAlt l ss e) = S.GuardedAlt (getPointLoc l) (map sStmt ss) (sExp e)
Something went wrong with that request. Please try again.