-
Notifications
You must be signed in to change notification settings - Fork 113
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
7 changed files
with
126 additions
and
51 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,61 @@ | ||
{-# LANGUAGE CPP #-} | ||
{-# LANGUAGE RecordWildCards #-} | ||
|
||
module HIndent.Ast.Declaration.Rule | ||
( RuleDeclaration | ||
, mkRuleDeclaration | ||
) where | ||
|
||
import qualified GHC.Core as GHC | ||
import qualified GHC.Data.FastString as GHC | ||
import HIndent.Ast.Declaration.Rule.Binder | ||
import HIndent.Ast.NodeComments | ||
import HIndent.Ast.WithComments | ||
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC | ||
import {-# SOURCE #-} HIndent.Pretty | ||
import HIndent.Pretty.Combinators | ||
import HIndent.Pretty.NodeComments | ||
|
||
data RuleDeclaration = RuleDeclaration | ||
{ name :: WithComments GHC.RuleName | ||
, binders :: [WithComments RuleBinder] | ||
, lhs :: WithComments (GHC.HsExpr GHC.GhcPs) | ||
, rhs :: WithComments (GHC.HsExpr GHC.GhcPs) | ||
} | ||
|
||
instance CommentExtraction RuleDeclaration where | ||
nodeComments RuleDeclaration {} = NodeComments [] [] [] | ||
|
||
instance Pretty RuleDeclaration where | ||
pretty' (RuleDeclaration {..}) = | ||
spaced | ||
[ prettyWith name (doubleQuotes . string . GHC.unpackFS) | ||
, prettyLhs | ||
, string "=" | ||
, pretty rhs | ||
] | ||
where | ||
prettyLhs = | ||
if null binders | ||
then pretty lhs | ||
else do | ||
string "forall " | ||
spaced $ fmap pretty binders | ||
dot | ||
space | ||
pretty lhs | ||
|
||
mkRuleDeclaration :: GHC.RuleDecl GHC.GhcPs -> RuleDeclaration | ||
mkRuleDeclaration rule@GHC.HsRule {..} = RuleDeclaration {..} | ||
where | ||
name = getName rule | ||
binders = fmap (fmap mkRuleBinder . fromGenLocated) rd_tmvs | ||
lhs = fromGenLocated rd_lhs | ||
rhs = fromGenLocated rd_rhs | ||
|
||
getName :: GHC.RuleDecl GHC.GhcPs -> WithComments GHC.RuleName | ||
#if MIN_VERSION_ghc_lib_parser(9, 6, 1) | ||
getName = fromGenLocated . GHC.rd_name | ||
#else | ||
getName = fromGenLocated . fmap snd . GHC.rd_name | ||
#endif |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,31 @@ | ||
{-# LANGUAGE RecordWildCards #-} | ||
|
||
module HIndent.Ast.Declaration.Rule.Binder | ||
( RuleBinder | ||
, mkRuleBinder | ||
) where | ||
|
||
import HIndent.Ast.NodeComments | ||
import HIndent.Ast.WithComments | ||
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC | ||
import {-# SOURCE #-} HIndent.Pretty | ||
import HIndent.Pretty.Combinators | ||
import HIndent.Pretty.NodeComments | ||
|
||
data RuleBinder = RuleBinder | ||
{ name :: GHC.LIdP GHC.GhcPs | ||
, signature :: Maybe (WithComments (GHC.HsType GHC.GhcPs)) | ||
} | ||
|
||
instance CommentExtraction RuleBinder where | ||
nodeComments RuleBinder {} = NodeComments [] [] [] | ||
|
||
instance Pretty RuleBinder where | ||
pretty' RuleBinder {signature = Nothing, ..} = pretty name | ||
pretty' RuleBinder {signature = Just sig, ..} = | ||
parens $ spaced [pretty name, string "::", pretty sig] | ||
|
||
mkRuleBinder :: GHC.RuleBndr GHC.GhcPs -> RuleBinder | ||
mkRuleBinder (GHC.RuleBndr _ name) = RuleBinder {signature = Nothing, ..} | ||
mkRuleBinder (GHC.RuleBndrSig _ name GHC.HsPS {..}) = | ||
RuleBinder {signature = Just $ fromGenLocated hsps_body, ..} |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,28 @@ | ||
{-# LANGUAGE RecordWildCards #-} | ||
|
||
module HIndent.Ast.Declaration.Rule.Collection | ||
( RuleCollection | ||
, mkRuleCollection | ||
) where | ||
|
||
import HIndent.Ast.Declaration.Rule | ||
import HIndent.Ast.NodeComments | ||
import HIndent.Ast.WithComments | ||
import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC | ||
import {-# SOURCE #-} HIndent.Pretty | ||
import HIndent.Pretty.Combinators | ||
import HIndent.Pretty.NodeComments | ||
|
||
newtype RuleCollection = | ||
RuleCollection [WithComments RuleDeclaration] | ||
|
||
instance CommentExtraction RuleCollection where | ||
nodeComments RuleCollection {} = NodeComments [] [] [] | ||
|
||
instance Pretty RuleCollection where | ||
pretty' (RuleCollection xs) = | ||
lined $ string "{-# RULES" : fmap pretty xs ++ [string " #-}"] | ||
|
||
mkRuleCollection :: GHC.RuleDecls GHC.GhcPs -> RuleCollection | ||
mkRuleCollection GHC.HsRules {..} = | ||
RuleCollection $ fmap (fmap mkRuleDeclaration . fromGenLocated) rds_rules |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters