-
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.
Implement
ClassDeclaration, DataFamilyInstance, and `TypeFamilyIn…
…stance` (#846) * Fix compile errors * Moved * Move all instances * Format * Make hlint happy * Do not export an unnecessary function * Remove the `HsDecl` instance * Fix * Define `ClassDeclaration` * Format * Use `mkClassDeclaration` * Remove a branch * Inline the instance * Remove an unused instance * Add a field * Return a `Maybe` * Use `context` * Use `>>` * Use `>>` * Add `name` * Add `NameAndTypeVariables` * Split * Add a test * Pass the test * Add a changelog * Format * Fix * `functionalDependencios` * `associatedThings` * Split * Format * Remove parentheses * Add `DataFamilyInstance` * `DataFamilyInstance` * Add a field * `inst` * Format * Inline an instance * `newOrData` * `name` * `types` * `Body` * Remove a pragma * Fix * Remove `inst` * Refactor * Format * Fix * Add `TypeFamilyInstance` * `Pretty` * Remove a branch * Add a field * Inline * `name` * Remove `inst` * Remove an instance * Format
- Loading branch information
Showing
10 changed files
with
341 additions
and
200 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,38 @@ | ||
| {-# LANGUAGE RecordWildCards #-} | ||
|
|
||
| module HIndent.Ast.Declaration.Class | ||
| ( ClassDeclaration(..) | ||
| , mkClassDeclaration | ||
| ) where | ||
|
|
||
| import qualified GHC.Data.Bag as GHC | ||
| import HIndent.Ast.Context | ||
| import HIndent.Ast.Declaration.Class.FunctionalDependency | ||
| import HIndent.Ast.Declaration.Class.NameAndTypeVariables | ||
| import HIndent.Ast.NodeComments | ||
| import HIndent.Ast.WithComments | ||
| import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC | ||
| import HIndent.Pretty.NodeComments | ||
| import HIndent.Pretty.SigBindFamily | ||
|
|
||
| data ClassDeclaration = ClassDeclaration | ||
| { context :: Maybe (WithComments Context) | ||
| , nameAndTypeVariables :: NameAndTypeVariables | ||
| , functionalDependencies :: [WithComments FunctionalDependency] | ||
| , associatedThings :: [LSigBindFamily] | ||
| } | ||
|
|
||
| instance CommentExtraction ClassDeclaration where | ||
| nodeComments ClassDeclaration {} = NodeComments [] [] [] | ||
|
|
||
| mkClassDeclaration :: GHC.TyClDecl GHC.GhcPs -> Maybe ClassDeclaration | ||
| mkClassDeclaration x@GHC.ClassDecl {..} | ||
| | Just nameAndTypeVariables <- mkNameAndTypeVariables x = | ||
| Just ClassDeclaration {..} | ||
| where | ||
| context = fmap (fmap mkContext . fromGenLocated) tcdCtxt | ||
| functionalDependencies = | ||
| fmap (fmap mkFunctionalDependency . fromGenLocated) tcdFDs | ||
| associatedThings = | ||
| mkSortedLSigBindFamilyList tcdSigs (GHC.bagToList tcdMeths) tcdATs [] [] | ||
| mkClassDeclaration _ = Nothing |
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,21 @@ | ||
| {-# LANGUAGE RecordWildCards #-} | ||
|
|
||
| module HIndent.Ast.Declaration.Class.FunctionalDependency | ||
| ( FunctionalDependency(..) | ||
| , mkFunctionalDependency | ||
| ) where | ||
|
|
||
| import HIndent.Ast.NodeComments | ||
| import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC | ||
| import HIndent.Pretty.NodeComments | ||
|
|
||
| data FunctionalDependency = FunctionalDependency | ||
| { from :: [GHC.LIdP GHC.GhcPs] | ||
| , to :: [GHC.LIdP GHC.GhcPs] | ||
| } | ||
|
|
||
| instance CommentExtraction FunctionalDependency where | ||
| nodeComments FunctionalDependency {} = NodeComments [] [] [] | ||
|
|
||
| mkFunctionalDependency :: GHC.FunDep GHC.GhcPs -> FunctionalDependency | ||
| mkFunctionalDependency (GHC.FunDep _ from to) = FunctionalDependency {..} |
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,47 @@ | ||
| {-# LANGUAGE RecordWildCards #-} | ||
|
|
||
| module HIndent.Ast.Declaration.Class.NameAndTypeVariables | ||
| ( NameAndTypeVariables(..) | ||
| , mkNameAndTypeVariables | ||
| ) where | ||
|
|
||
| import qualified GHC.Types.Fixity as GHC | ||
| import HIndent.Ast.NodeComments | ||
| import HIndent.Ast.Type.Variable | ||
| import HIndent.Ast.WithComments | ||
| import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC | ||
| import HIndent.Pretty.NodeComments | ||
|
|
||
| data NameAndTypeVariables | ||
| = Prefix | ||
| { name :: GHC.LIdP GHC.GhcPs | ||
| , typeVariables :: [WithComments TypeVariable] | ||
| } | ||
| | Infix | ||
| { left :: WithComments TypeVariable | ||
| , name :: GHC.LIdP GHC.GhcPs | ||
| , right :: WithComments TypeVariable | ||
| , remains :: [WithComments TypeVariable] | ||
| } | ||
|
|
||
| instance CommentExtraction NameAndTypeVariables where | ||
| nodeComments Prefix {} = NodeComments [] [] [] | ||
| nodeComments Infix {} = NodeComments [] [] [] | ||
|
|
||
| mkNameAndTypeVariables :: GHC.TyClDecl GHC.GhcPs -> Maybe NameAndTypeVariables | ||
| mkNameAndTypeVariables GHC.ClassDecl {tcdFixity = GHC.Prefix, ..} = | ||
| Just Prefix {..} | ||
| where | ||
| name = tcdLName | ||
| typeVariables = | ||
| fmap mkTypeVariable . fromGenLocated <$> GHC.hsq_explicit tcdTyVars | ||
| mkNameAndTypeVariables GHC.ClassDecl { tcdFixity = GHC.Infix | ||
| , tcdTyVars = GHC.HsQTvs {hsq_explicit = h:t:xs} | ||
| , .. | ||
| } = Just Infix {..} | ||
| where | ||
| left = mkTypeVariable <$> fromGenLocated h | ||
| name = tcdLName | ||
| right = mkTypeVariable <$> fromGenLocated t | ||
| remains = fmap (fmap mkTypeVariable . fromGenLocated) xs | ||
| mkNameAndTypeVariables _ = Nothing |
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 |
|---|---|---|
| @@ -1,65 +1,26 @@ | ||
| {-# LANGUAGE CPP #-} | ||
| {-# LANGUAGE RecordWildCards #-} | ||
| {-# LANGUAGE ViewPatterns #-} | ||
|
|
||
| module HIndent.Ast.Declaration.Data | ||
| ( DataDeclaration(..) | ||
| , mkDataDeclaration | ||
| ) where | ||
|
|
||
| import Data.Maybe | ||
| import qualified GHC.Types.SrcLoc as GHC | ||
| import HIndent.Ast.Declaration.Data.GADT.Constructor | ||
| import HIndent.Ast.Declaration.Data.Body | ||
| import HIndent.Ast.Declaration.Data.Header | ||
| import HIndent.Ast.NodeComments | ||
| import HIndent.Ast.Type | ||
| import HIndent.Ast.WithComments | ||
| import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC | ||
| import HIndent.Pretty.NodeComments | ||
|
|
||
| data DataDeclaration | ||
| = GADT | ||
| { header :: Header | ||
| , kind :: Maybe (WithComments Type) | ||
| , constructors :: [WithComments GADTConstructor] | ||
| } | ||
| | Record | ||
| { header :: Header | ||
| , dd_cons :: [GHC.LConDecl GHC.GhcPs] | ||
| , dd_derivs :: GHC.HsDeriving GHC.GhcPs | ||
| } | ||
| data DataDeclaration = DataDeclaration | ||
| { header :: Header | ||
| , body :: DataBody | ||
| } | ||
|
|
||
| instance CommentExtraction DataDeclaration where | ||
| nodeComments GADT {} = NodeComments [] [] [] | ||
| nodeComments Record {} = NodeComments [] [] [] | ||
| nodeComments DataDeclaration {} = NodeComments [] [] [] | ||
|
|
||
| mkDataDeclaration :: GHC.TyClDecl GHC.GhcPs -> Maybe DataDeclaration | ||
| mkDataDeclaration decl@GHC.DataDecl {tcdDataDefn = defn@GHC.HsDataDefn {..}} | ||
| | Just header <- mkHeader decl = | ||
| Just | ||
| $ if isGADT defn | ||
| then GADT | ||
| { constructors = | ||
| fromMaybe (error "Some constructors are not GADT ones.") | ||
| $ mapM (traverse mkGADTConstructor . fromGenLocated) | ||
| $ getConDecls defn | ||
| , .. | ||
| } | ||
| else Record {dd_cons = getConDecls defn, ..} | ||
| where | ||
| kind = fmap mkType . fromGenLocated <$> dd_kindSig | ||
| mkDataDeclaration decl@GHC.DataDecl {..} = | ||
| DataDeclaration <$> mkHeader decl <*> pure (mkDataBody tcdDataDefn) | ||
| mkDataDeclaration _ = Nothing | ||
|
|
||
| isGADT :: GHC.HsDataDefn GHC.GhcPs -> Bool | ||
| isGADT (getConDecls -> (GHC.L _ GHC.ConDeclGADT {}:_)) = True | ||
| isGADT _ = False | ||
|
|
||
| getConDecls :: GHC.HsDataDefn GHC.GhcPs -> [GHC.LConDecl GHC.GhcPs] | ||
| #if MIN_VERSION_ghc_lib_parser(9, 6, 0) | ||
| getConDecls GHC.HsDataDefn {..} = | ||
| case dd_cons of | ||
| GHC.NewTypeCon x -> [x] | ||
| GHC.DataTypeCons _ xs -> xs | ||
| #else | ||
| getConDecls GHC.HsDataDefn {..} = dd_cons | ||
| #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,59 @@ | ||
| {-# LANGUAGE CPP #-} | ||
| {-# LANGUAGE RecordWildCards #-} | ||
| {-# LANGUAGE ViewPatterns #-} | ||
|
|
||
| module HIndent.Ast.Declaration.Data.Body | ||
| ( DataBody(..) | ||
| , mkDataBody | ||
| ) where | ||
|
|
||
| import Data.Maybe | ||
| import qualified GHC.Types.SrcLoc as GHC | ||
| import HIndent.Ast.Declaration.Data.GADT.Constructor | ||
| import HIndent.Ast.NodeComments | ||
| import HIndent.Ast.Type | ||
| import HIndent.Ast.WithComments | ||
| import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC | ||
| import HIndent.Pretty.NodeComments | ||
|
|
||
| data DataBody | ||
| = GADT | ||
| { kind :: Maybe (WithComments Type) | ||
| , constructors :: [WithComments GADTConstructor] | ||
| } | ||
| | Record | ||
| { dd_cons :: [GHC.LConDecl GHC.GhcPs] | ||
| , dd_derivs :: GHC.HsDeriving GHC.GhcPs | ||
| } | ||
|
|
||
| instance CommentExtraction DataBody where | ||
| nodeComments GADT {} = NodeComments [] [] [] | ||
| nodeComments Record {} = NodeComments [] [] [] | ||
|
|
||
| mkDataBody :: GHC.HsDataDefn GHC.GhcPs -> DataBody | ||
| mkDataBody defn@GHC.HsDataDefn {..} = | ||
| if isGADT defn | ||
| then GADT | ||
| { constructors = | ||
| fromMaybe (error "Some constructors are not GADT ones.") | ||
| $ mapM (traverse mkGADTConstructor . fromGenLocated) | ||
| $ getConDecls defn | ||
| , .. | ||
| } | ||
| else Record {dd_cons = getConDecls defn, ..} | ||
| where | ||
| kind = fmap mkType . fromGenLocated <$> dd_kindSig | ||
|
|
||
| isGADT :: GHC.HsDataDefn GHC.GhcPs -> Bool | ||
| isGADT (getConDecls -> (GHC.L _ GHC.ConDeclGADT {}:_)) = True | ||
| isGADT _ = False | ||
|
|
||
| getConDecls :: GHC.HsDataDefn GHC.GhcPs -> [GHC.LConDecl GHC.GhcPs] | ||
| #if MIN_VERSION_ghc_lib_parser(9, 6, 0) | ||
| getConDecls GHC.HsDataDefn {..} = | ||
| case dd_cons of | ||
| GHC.NewTypeCon x -> [x] | ||
| GHC.DataTypeCons _ xs -> xs | ||
| #else | ||
| getConDecls GHC.HsDataDefn {..} = dd_cons | ||
| #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,32 @@ | ||
| {-# LANGUAGE RecordWildCards #-} | ||
|
|
||
| module HIndent.Ast.Declaration.Instance.Family.Data | ||
| ( DataFamilyInstance(..) | ||
| , mkDataFamilyInstance | ||
| ) where | ||
|
|
||
| import qualified GHC.Hs as GG | ||
| import HIndent.Ast.Declaration.Data.Body | ||
| import HIndent.Ast.Declaration.Data.NewOrData | ||
| import HIndent.Ast.NodeComments | ||
| import qualified HIndent.GhcLibParserWrapper.GHC.Hs as GHC | ||
| import HIndent.Pretty.NodeComments | ||
|
|
||
| data DataFamilyInstance = DataFamilyInstance | ||
| { newOrData :: NewOrData | ||
| , name :: GHC.LIdP GHC.GhcPs | ||
| , types :: GHC.HsTyPats GHC.GhcPs | ||
| , body :: DataBody | ||
| } | ||
|
|
||
| instance CommentExtraction DataFamilyInstance where | ||
| nodeComments DataFamilyInstance {} = NodeComments [] [] [] | ||
|
|
||
| mkDataFamilyInstance :: | ||
| GHC.FamEqn GHC.GhcPs (GHC.HsDataDefn GHC.GhcPs) -> DataFamilyInstance | ||
| mkDataFamilyInstance GHC.FamEqn {..} = DataFamilyInstance {..} | ||
| where | ||
| newOrData = mkNewOrData feqn_rhs | ||
| name = feqn_tycon | ||
| types = feqn_pats | ||
| body = mkDataBody feqn_rhs |
Oops, something went wrong.