module HIndent.Ast.Declaration.Data.Deriving.Clause ( DerivingClause , mkDerivingClause , hasDerivings ) where import HIndent.Ast.Declaration.Data.Deriving 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 DerivingClause = DerivingClause [WithComments Deriving] instance CommentExtraction DerivingClause where nodeComments :: DerivingClause -> NodeComments nodeComments DerivingClause {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] instance Pretty DerivingClause where pretty' :: DerivingClause -> Printer () pretty' (DerivingClause [WithComments Deriving] xs) = [Printer ()] -> Printer () lined ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer () forall a b. (a -> b) -> a -> b $ (WithComments Deriving -> Printer ()) -> [WithComments Deriving] -> [Printer ()] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap WithComments Deriving -> Printer () forall a. Pretty a => a -> Printer () pretty [WithComments Deriving] xs mkDerivingClause :: GHC.HsDeriving GHC.GhcPs -> DerivingClause mkDerivingClause :: HsDeriving GhcPs -> DerivingClause mkDerivingClause = [WithComments Deriving] -> DerivingClause DerivingClause ([WithComments Deriving] -> DerivingClause) -> ([GenLocated EpAnnCO (HsDerivingClause GhcPs)] -> [WithComments Deriving]) -> [GenLocated EpAnnCO (HsDerivingClause GhcPs)] -> DerivingClause forall b c a. (b -> c) -> (a -> b) -> a -> c . (GenLocated EpAnnCO (HsDerivingClause GhcPs) -> WithComments Deriving) -> [GenLocated EpAnnCO (HsDerivingClause GhcPs)] -> [WithComments Deriving] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((HsDerivingClause GhcPs -> Deriving) -> WithComments (HsDerivingClause GhcPs) -> WithComments Deriving forall a b. (a -> b) -> WithComments a -> WithComments b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap HsDerivingClause GhcPs -> Deriving mkDeriving (WithComments (HsDerivingClause GhcPs) -> WithComments Deriving) -> (GenLocated EpAnnCO (HsDerivingClause GhcPs) -> WithComments (HsDerivingClause GhcPs)) -> GenLocated EpAnnCO (HsDerivingClause GhcPs) -> WithComments Deriving forall b c a. (b -> c) -> (a -> b) -> a -> c . GenLocated EpAnnCO (HsDerivingClause GhcPs) -> WithComments (HsDerivingClause GhcPs) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated) hasDerivings :: DerivingClause -> Bool hasDerivings :: DerivingClause -> Bool hasDerivings (DerivingClause []) = Bool False hasDerivings DerivingClause _ = Bool True