{-# 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)