{-# LANGUAGE RecordWildCards #-} module HIndent.Ast.Declaration.Data.Deriving ( Deriving , mkDeriving ) where import qualified GHC.Types.SrcLoc as GHC import HIndent.Applicative import HIndent.Ast.Declaration.Data.Deriving.Strategy 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 Deriving = Deriving { Deriving -> Maybe (WithComments DerivingStrategy) strategy :: Maybe (WithComments DerivingStrategy) , Deriving -> WithComments [LHsSigType GhcPs] classes :: WithComments [GHC.LHsSigType GHC.GhcPs] } instance CommentExtraction Deriving where nodeComments :: Deriving -> NodeComments nodeComments Deriving {} = [LEpaComment] -> [LEpaComment] -> [LEpaComment] -> NodeComments NodeComments [] [] [] instance Pretty Deriving where pretty' :: Deriving -> Printer () pretty' Deriving {strategy :: Deriving -> Maybe (WithComments DerivingStrategy) strategy = Just WithComments DerivingStrategy strategy, WithComments [LHsSigType GhcPs] classes :: Deriving -> WithComments [LHsSigType GhcPs] classes :: WithComments [LHsSigType GhcPs] ..} | DerivingStrategy -> Bool isViaStrategy (WithComments DerivingStrategy -> DerivingStrategy forall a. WithComments a -> a getNode WithComments DerivingStrategy strategy) = do [Printer ()] -> Printer () spaced [ HasCallStack => String -> Printer () String -> Printer () string String "deriving" , WithComments [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> ([GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> Printer ()) -> Printer () forall a. WithComments a -> (a -> Printer ()) -> Printer () prettyWith WithComments [LHsSigType GhcPs] WithComments [GenLocated SrcSpanAnnA (HsSigType GhcPs)] classes ([Printer ()] -> Printer () hvTuple ([Printer ()] -> Printer ()) -> ([GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> [Printer ()]) -> [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> Printer () forall b c a. (b -> c) -> (a -> b) -> a -> c . (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()) -> [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> [Printer ()] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer () forall a. Pretty a => a -> Printer () pretty) , WithComments DerivingStrategy -> Printer () forall a. Pretty a => a -> Printer () pretty WithComments DerivingStrategy strategy ] pretty' Deriving {Maybe (WithComments DerivingStrategy) WithComments [LHsSigType GhcPs] strategy :: Deriving -> Maybe (WithComments DerivingStrategy) classes :: Deriving -> WithComments [LHsSigType GhcPs] strategy :: Maybe (WithComments DerivingStrategy) classes :: WithComments [LHsSigType GhcPs] ..} = do HasCallStack => String -> Printer () String -> Printer () string String "deriving " Maybe (WithComments DerivingStrategy) -> (WithComments DerivingStrategy -> Printer ()) -> Printer () forall (m :: * -> *) a. Applicative m => Maybe a -> (a -> m ()) -> m () whenJust Maybe (WithComments DerivingStrategy) strategy ((WithComments DerivingStrategy -> Printer ()) -> Printer ()) -> (WithComments DerivingStrategy -> Printer ()) -> Printer () forall a b. (a -> b) -> a -> b $ \WithComments DerivingStrategy x -> WithComments DerivingStrategy -> Printer () forall a. Pretty a => a -> Printer () pretty WithComments DerivingStrategy x Printer () -> Printer () -> Printer () forall a b. Printer a -> Printer b -> Printer b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Printer () space WithComments [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> ([GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> Printer ()) -> Printer () forall a. WithComments a -> (a -> Printer ()) -> Printer () prettyWith WithComments [LHsSigType GhcPs] WithComments [GenLocated SrcSpanAnnA (HsSigType GhcPs)] classes ([Printer ()] -> Printer () hvTuple ([Printer ()] -> Printer ()) -> ([GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> [Printer ()]) -> [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> Printer () forall b c a. (b -> c) -> (a -> b) -> a -> c . (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer ()) -> [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> [Printer ()] forall a b. (a -> b) -> [a] -> [b] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap GenLocated SrcSpanAnnA (HsSigType GhcPs) -> Printer () forall a. Pretty a => a -> Printer () pretty) mkDeriving :: GHC.HsDerivingClause GHC.GhcPs -> Deriving mkDeriving :: HsDerivingClause GhcPs -> Deriving mkDeriving GHC.HsDerivingClause {Maybe (LDerivStrategy GhcPs) XCHsDerivingClause GhcPs LDerivClauseTys GhcPs deriv_clause_ext :: XCHsDerivingClause GhcPs deriv_clause_strategy :: Maybe (LDerivStrategy GhcPs) deriv_clause_tys :: LDerivClauseTys GhcPs deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass) deriv_clause_ext :: forall pass. HsDerivingClause pass -> XCHsDerivingClause pass ..} = Deriving {Maybe (WithComments DerivingStrategy) WithComments [LHsSigType GhcPs] WithComments [GenLocated SrcSpanAnnA (HsSigType GhcPs)] strategy :: Maybe (WithComments DerivingStrategy) classes :: WithComments [LHsSigType GhcPs] strategy :: Maybe (WithComments DerivingStrategy) classes :: WithComments [GenLocated SrcSpanAnnA (HsSigType GhcPs)] ..} where strategy :: Maybe (WithComments DerivingStrategy) strategy = (GenLocated EpAnnCO (DerivStrategy GhcPs) -> WithComments DerivingStrategy) -> Maybe (GenLocated EpAnnCO (DerivStrategy GhcPs)) -> Maybe (WithComments DerivingStrategy) forall a b. (a -> b) -> Maybe a -> Maybe b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((DerivStrategy GhcPs -> DerivingStrategy) -> WithComments (DerivStrategy GhcPs) -> WithComments DerivingStrategy forall a b. (a -> b) -> WithComments a -> WithComments b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap DerivStrategy GhcPs -> DerivingStrategy mkDerivingStrategy (WithComments (DerivStrategy GhcPs) -> WithComments DerivingStrategy) -> (GenLocated EpAnnCO (DerivStrategy GhcPs) -> WithComments (DerivStrategy GhcPs)) -> GenLocated EpAnnCO (DerivStrategy GhcPs) -> WithComments DerivingStrategy forall b c a. (b -> c) -> (a -> b) -> a -> c . GenLocated EpAnnCO (DerivStrategy GhcPs) -> WithComments (DerivStrategy GhcPs) forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated) Maybe (LDerivStrategy GhcPs) Maybe (GenLocated EpAnnCO (DerivStrategy GhcPs)) deriv_clause_strategy classes :: WithComments [GenLocated SrcSpanAnnA (HsSigType GhcPs)] classes = case LDerivClauseTys GhcPs deriv_clause_tys of GHC.L SrcSpanAnnC ann (GHC.DctSingle XDctSingle GhcPs _ LHsSigType GhcPs ty) -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> WithComments [GenLocated SrcSpanAnnA (HsSigType GhcPs)] forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated (SrcSpanAnnC -> [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsSigType GhcPs)] forall l e. l -> e -> GenLocated l e GHC.L SrcSpanAnnC ann [LHsSigType GhcPs GenLocated SrcSpanAnnA (HsSigType GhcPs) ty]) GHC.L SrcSpanAnnC ann (GHC.DctMulti XDctMulti GhcPs _ [LHsSigType GhcPs] tys) -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> WithComments [GenLocated SrcSpanAnnA (HsSigType GhcPs)] forall l a. CommentExtraction l => GenLocated l a -> WithComments a fromGenLocated (SrcSpanAnnC -> [GenLocated SrcSpanAnnA (HsSigType GhcPs)] -> GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsSigType GhcPs)] forall l e. l -> e -> GenLocated l e GHC.L SrcSpanAnnC ann [LHsSigType GhcPs] [GenLocated SrcSpanAnnA (HsSigType GhcPs)] tys)