diff --git a/src/HIndent/Ast/Declaration/Data/Body.hs b/src/HIndent/Ast/Declaration/Data/Body.hs index 72907de78..5dc7f874b 100644 --- a/src/HIndent/Ast/Declaration/Data/Body.hs +++ b/src/HIndent/Ast/Declaration/Data/Body.hs @@ -1,49 +1,37 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE ViewPatterns #-} module HIndent.Ast.Declaration.Data.Body ( DataBody , mkDataBody ) where -import Control.Monad -import Data.Maybe -import qualified GHC.Types.SrcLoc as GHC -import HIndent.Applicative -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 {-# SOURCE #-} HIndent.Pretty -import HIndent.Pretty.Combinators -import HIndent.Pretty.NodeComments - -newtype RecordConstructor = - RecordConstructor (GHC.LConDecl GHC.GhcPs) - -instance CommentExtraction RecordConstructor where - nodeComments RecordConstructor {} = NodeComments [] [] [] - -instance Pretty RecordConstructor where - pretty' (RecordConstructor x) = pretty x - -mkRecordConstructor :: GHC.LConDecl GHC.GhcPs -> RecordConstructor -mkRecordConstructor = RecordConstructor +import Control.Monad +import Data.Maybe +import qualified GHC.Types.SrcLoc as GHC +import HIndent.Applicative +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 {-# SOURCE #-} HIndent.Pretty +import HIndent.Pretty.Combinators +import HIndent.Pretty.NodeComments data DataBody = GADT - { kind :: Maybe (WithComments Type) + { kind :: Maybe (WithComments Type) , constructors :: [WithComments GADTConstructor] } | Record - { dd_cons :: [RecordConstructor] + { dd_cons :: [GHC.LConDecl GHC.GhcPs] , dd_derivs :: GHC.HsDeriving GHC.GhcPs } instance CommentExtraction DataBody where - nodeComments GADT {} = NodeComments [] [] [] + nodeComments GADT {} = NodeComments [] [] [] nodeComments Record {} = NodeComments [] [] [] instance Pretty DataBody where @@ -54,7 +42,7 @@ instance Pretty DataBody where pretty' Record {..} = do case dd_cons of [] -> indentedBlock derivingsAfterNewline - [RecordConstructor (x@(GHC.L _ GHC.ConDeclH98 {con_args = GHC.RecCon {}}))] -> do + [x@(GHC.L _ GHC.ConDeclH98 {con_args = GHC.RecCon {}})] -> do string " = " pretty x unless (null dd_derivs) $ space |=> printDerivings @@ -79,24 +67,24 @@ mkDataBody defn@GHC.HsDataDefn {..} = if isGADT defn then GADT { constructors = - fromMaybe (error "Some constructors are not GADT ones.") $ - mapM (traverse mkGADTConstructor . fromGenLocated) $ - getConDecls defn + fromMaybe (error "Some constructors are not GADT ones.") + $ mapM (traverse mkGADTConstructor . fromGenLocated) + $ getConDecls defn , .. } - else Record {dd_cons = fmap mkRecordConstructor $ 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 +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.NewTypeCon x -> [x] GHC.DataTypeCons _ xs -> xs #else getConDecls GHC.HsDataDefn {..} = dd_cons