{-# LANGUAGE BlockArguments   #-}
{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE DoAndIfThenElse  #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase       #-}
{-# LANGUAGE MultiWayIf       #-}
{-# LANGUAGE NamedFieldPuns   #-}
{-# LANGUAGE RecordWildCards  #-}
module Language.Haskell.Stylish.Step.Data
  ( Config(..)
  , defaultConfig

  , Indent(..)
  , MaxColumns(..)
  , step
  ) where


--------------------------------------------------------------------------------
import           Control.Monad                     (forM_, unless, when)
import           Data.Foldable                     (toList)
import           Data.List                         (sortBy)
import           Data.Maybe                        (listToMaybe, maybeToList)
import qualified GHC.Hs                            as GHC
import qualified GHC.Types.Fixity                  as GHC
import qualified GHC.Types.Name.Reader             as GHC
import qualified GHC.Types.SrcLoc                  as GHC
import           Prelude                           hiding (init)


--------------------------------------------------------------------------------
import           Language.Haskell.Stylish.Comments
import qualified Language.Haskell.Stylish.Editor   as Editor
import           Language.Haskell.Stylish.GHC
import           Language.Haskell.Stylish.Module
import           Language.Haskell.Stylish.Ordering
import           Language.Haskell.Stylish.Printer
import           Language.Haskell.Stylish.Step
import           Language.Haskell.Stylish.Util


--------------------------------------------------------------------------------
data Indent
    = SameLine
    | Indent !Int
  deriving (Int -> Indent -> ShowS
[Indent] -> ShowS
Indent -> [Char]
(Int -> Indent -> ShowS)
-> (Indent -> [Char]) -> ([Indent] -> ShowS) -> Show Indent
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Indent -> ShowS
showsPrec :: Int -> Indent -> ShowS
$cshow :: Indent -> [Char]
show :: Indent -> [Char]
$cshowList :: [Indent] -> ShowS
showList :: [Indent] -> ShowS
Show, Indent -> Indent -> Bool
(Indent -> Indent -> Bool)
-> (Indent -> Indent -> Bool) -> Eq Indent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Indent -> Indent -> Bool
== :: Indent -> Indent -> Bool
$c/= :: Indent -> Indent -> Bool
/= :: Indent -> Indent -> Bool
Eq)

data MaxColumns
  = MaxColumns !Int
  | NoMaxColumns
  deriving (Int -> MaxColumns -> ShowS
[MaxColumns] -> ShowS
MaxColumns -> [Char]
(Int -> MaxColumns -> ShowS)
-> (MaxColumns -> [Char])
-> ([MaxColumns] -> ShowS)
-> Show MaxColumns
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MaxColumns -> ShowS
showsPrec :: Int -> MaxColumns -> ShowS
$cshow :: MaxColumns -> [Char]
show :: MaxColumns -> [Char]
$cshowList :: [MaxColumns] -> ShowS
showList :: [MaxColumns] -> ShowS
Show, MaxColumns -> MaxColumns -> Bool
(MaxColumns -> MaxColumns -> Bool)
-> (MaxColumns -> MaxColumns -> Bool) -> Eq MaxColumns
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MaxColumns -> MaxColumns -> Bool
== :: MaxColumns -> MaxColumns -> Bool
$c/= :: MaxColumns -> MaxColumns -> Bool
/= :: MaxColumns -> MaxColumns -> Bool
Eq)

data Config = Config
    { Config -> Indent
cEquals                  :: !Indent
      -- ^ Indent between type constructor and @=@ sign (measured from column 0)
    , Config -> Indent
cFirstField              :: !Indent
      -- ^ Indent between data constructor and @{@ line (measured from column with data constructor name)
    , Config -> Int
cFieldComment            :: !Int
      -- ^ Indent between column with @{@ and start of field line comment (this line has @cFieldComment = 2@)
    , Config -> Int
cDeriving                :: !Int
      -- ^ Indent before @deriving@ lines (measured from column 0)
    , Config -> Bool
cBreakEnums              :: !Bool
      -- ^ Break enums by newlines and follow the above rules
    , Config -> Bool
cBreakSingleConstructors :: !Bool
      -- ^ Break single constructors when enabled, e.g. @Indent 2@ will not cause newline after @=@
    , Config -> Indent
cVia                     :: !Indent
      -- ^ Indentation between @via@ clause and start of deriving column start
    , Config -> Bool
cCurriedContext          :: !Bool
      -- ^ If true, use curried context. E.g: @allValues :: Enum a => Bounded a => Proxy a -> [a]@
    , Config -> Bool
cSortDeriving            :: !Bool
      -- ^ If true, will sort type classes in a @deriving@ list.
    , Config -> MaxColumns
cMaxColumns              :: !MaxColumns
    } deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> [Char]
(Int -> Config -> ShowS)
-> (Config -> [Char]) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Config -> ShowS
showsPrec :: Int -> Config -> ShowS
$cshow :: Config -> [Char]
show :: Config -> [Char]
$cshowList :: [Config] -> ShowS
showList :: [Config] -> ShowS
Show)

-- | TODO: pass in MaxColumns?
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config
    { cEquals :: Indent
cEquals          = Int -> Indent
Indent Int
4
    , cFirstField :: Indent
cFirstField      = Int -> Indent
Indent Int
4
    , cFieldComment :: Int
cFieldComment    = Int
2
    , cDeriving :: Int
cDeriving        = Int
4
    , cBreakEnums :: Bool
cBreakEnums      = Bool
True
    , cBreakSingleConstructors :: Bool
cBreakSingleConstructors = Bool
False
    , cVia :: Indent
cVia             = Int -> Indent
Indent Int
4
    , cSortDeriving :: Bool
cSortDeriving    = Bool
True
    , cMaxColumns :: MaxColumns
cMaxColumns      = MaxColumns
NoMaxColumns
    , cCurriedContext :: Bool
cCurriedContext    = Bool
False
    }

step :: Config -> Step
step :: Config -> Step
step Config
cfg = [Char] -> (Lines -> Module -> Lines) -> Step
makeStep [Char]
"Data" \Lines
ls Module
m -> Edits -> Lines -> Lines
Editor.apply (Module -> Edits
changes Module
m) Lines
ls
  where
    changes :: Module -> Editor.Edits
    changes :: Module -> Edits
changes = (DataDecl -> Edits) -> [DataDecl] -> Edits
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Config -> DataDecl -> Edits
formatDataDecl Config
cfg) ([DataDecl] -> Edits) -> (Module -> [DataDecl]) -> Module -> Edits
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> [DataDecl]
dataDecls

    dataDecls :: Module -> [DataDecl]
    dataDecls :: Module -> [DataDecl]
dataDecls Module
m = do
        GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl <- HsModule GhcPs -> [LHsDecl GhcPs]
forall p. HsModule p -> [LHsDecl p]
GHC.hsmodDecls (HsModule GhcPs -> [LHsDecl GhcPs])
-> HsModule GhcPs -> [LHsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ Module -> HsModule GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc Module
m
        GHC.TyClD XTyClD GhcPs
_ TyClDecl GhcPs
tycld <- HsDecl GhcPs -> [HsDecl GhcPs]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsDecl GhcPs -> [HsDecl GhcPs]) -> HsDecl GhcPs -> [HsDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsDecl GhcPs) -> HsDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl
        RealSrcSpan
loc <- Maybe RealSrcSpan -> [RealSrcSpan]
forall a. Maybe a -> [a]
maybeToList (Maybe RealSrcSpan -> [RealSrcSpan])
-> Maybe RealSrcSpan -> [RealSrcSpan]
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan (SrcSpan -> Maybe RealSrcSpan) -> SrcSpan -> Maybe RealSrcSpan
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsDecl GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl
        case TyClDecl GhcPs
tycld of
            GHC.DataDecl {XDataDecl GhcPs
LIdP GhcPs
LexicalFixity
LHsQTyVars GhcPs
HsDataDefn GhcPs
tcdDExt :: XDataDecl GhcPs
tcdLName :: LIdP GhcPs
tcdTyVars :: LHsQTyVars GhcPs
tcdFixity :: LexicalFixity
tcdDataDefn :: HsDataDefn GhcPs
tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdFixity :: forall pass. TyClDecl pass -> LexicalFixity
tcdDExt :: forall pass. TyClDecl pass -> XDataDecl pass
tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
..} -> DataDecl -> [DataDecl]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DataDecl -> [DataDecl]) -> DataDecl -> [DataDecl]
forall a b. (a -> b) -> a -> b
$ MkDataDecl
                { dataComments :: [LEpaComment]
dataComments = EpAnn [AddEpAnn] -> [LEpaComment]
forall a. EpAnn a -> [LEpaComment]
epAnnComments XDataDecl GhcPs
EpAnn [AddEpAnn]
tcdDExt
                , dataLoc :: RealSrcSpan
dataLoc      = RealSrcSpan
loc
                , dataDeclName :: GenLocated SrcSpanAnnN RdrName
dataDeclName = LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
tcdLName
                , dataTypeVars :: LHsQTyVars GhcPs
dataTypeVars = LHsQTyVars GhcPs
tcdTyVars
                , dataDefn :: HsDataDefn GhcPs
dataDefn     = HsDataDefn GhcPs
tcdDataDefn
                , dataFixity :: LexicalFixity
dataFixity   = LexicalFixity
tcdFixity
                }
            TyClDecl GhcPs
_ -> []

data DataDecl = MkDataDecl
    { DataDecl -> [LEpaComment]
dataComments :: [GHC.LEpaComment]
    , DataDecl -> RealSrcSpan
dataLoc      :: GHC.RealSrcSpan
    , DataDecl -> GenLocated SrcSpanAnnN RdrName
dataDeclName :: GHC.LocatedN GHC.RdrName
    , DataDecl -> LHsQTyVars GhcPs
dataTypeVars :: GHC.LHsQTyVars GHC.GhcPs
    , DataDecl -> HsDataDefn GhcPs
dataDefn     :: GHC.HsDataDefn GHC.GhcPs
    , DataDecl -> LexicalFixity
dataFixity   :: GHC.LexicalFixity
    }


formatDataDecl :: Config -> DataDecl -> Editor.Edits
formatDataDecl :: Config -> DataDecl -> Edits
formatDataDecl cfg :: Config
cfg@Config{Bool
Int
MaxColumns
Indent
cEquals :: Config -> Indent
cFirstField :: Config -> Indent
cFieldComment :: Config -> Int
cDeriving :: Config -> Int
cBreakEnums :: Config -> Bool
cBreakSingleConstructors :: Config -> Bool
cVia :: Config -> Indent
cCurriedContext :: Config -> Bool
cSortDeriving :: Config -> Bool
cMaxColumns :: Config -> MaxColumns
cEquals :: Indent
cFirstField :: Indent
cFieldComment :: Int
cDeriving :: Int
cBreakEnums :: Bool
cBreakSingleConstructors :: Bool
cVia :: Indent
cCurriedContext :: Bool
cSortDeriving :: Bool
cMaxColumns :: MaxColumns
..} decl :: DataDecl
decl@MkDataDecl {[LEpaComment]
GenLocated SrcSpanAnnN RdrName
RealSrcSpan
LexicalFixity
LHsQTyVars GhcPs
HsDataDefn GhcPs
dataComments :: DataDecl -> [LEpaComment]
dataLoc :: DataDecl -> RealSrcSpan
dataDeclName :: DataDecl -> GenLocated SrcSpanAnnN RdrName
dataTypeVars :: DataDecl -> LHsQTyVars GhcPs
dataDefn :: DataDecl -> HsDataDefn GhcPs
dataFixity :: DataDecl -> LexicalFixity
dataComments :: [LEpaComment]
dataLoc :: RealSrcSpan
dataDeclName :: GenLocated SrcSpanAnnN RdrName
dataTypeVars :: LHsQTyVars GhcPs
dataDefn :: HsDataDefn GhcPs
dataFixity :: LexicalFixity
..} =
    Block [Char] -> (Lines -> Lines) -> Edits
Editor.changeLines Block [Char]
forall {a}. Block a
originalDeclBlock (Lines -> Lines -> Lines
forall a b. a -> b -> a
const Lines
printedDecl)
  where
    originalDeclBlock :: Block a
originalDeclBlock = Int -> Int -> Block a
forall a. Int -> Int -> Block a
Editor.Block
        (RealSrcSpan -> Int
GHC.srcSpanStartLine RealSrcSpan
dataLoc)
        (RealSrcSpan -> Int
GHC.srcSpanEndLine RealSrcSpan
dataLoc)

    printerConfig :: PrinterConfig
printerConfig = PrinterConfig
        { columns :: Maybe Int
columns = case MaxColumns
cMaxColumns of
            MaxColumns
NoMaxColumns -> Maybe Int
forall a. Maybe a
Nothing
            MaxColumns Int
n -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n
        }

    printedDecl :: Lines
printedDecl = PrinterConfig -> Printer () -> Lines
forall a. PrinterConfig -> Printer a -> Lines
runPrinter_ PrinterConfig
printerConfig (Printer () -> Lines) -> Printer () -> Lines
forall a b. (a -> b) -> a -> b
$ Config -> DataDecl -> Printer ()
putDataDecl Config
cfg DataDecl
decl

putDataDecl :: Config -> DataDecl -> P ()
putDataDecl :: Config -> DataDecl -> Printer ()
putDataDecl cfg :: Config
cfg@Config {Bool
Int
MaxColumns
Indent
cEquals :: Config -> Indent
cFirstField :: Config -> Indent
cFieldComment :: Config -> Int
cDeriving :: Config -> Int
cBreakEnums :: Config -> Bool
cBreakSingleConstructors :: Config -> Bool
cVia :: Config -> Indent
cCurriedContext :: Config -> Bool
cSortDeriving :: Config -> Bool
cMaxColumns :: Config -> MaxColumns
cEquals :: Indent
cFirstField :: Indent
cFieldComment :: Int
cDeriving :: Int
cBreakEnums :: Bool
cBreakSingleConstructors :: Bool
cVia :: Indent
cCurriedContext :: Bool
cSortDeriving :: Bool
cMaxColumns :: MaxColumns
..} DataDecl
decl = do
    let defn :: HsDataDefn GhcPs
defn = DataDecl -> HsDataDefn GhcPs
dataDefn DataDecl
decl
        constructorComments :: [CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs))]
constructorComments = (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Maybe RealSrcSpan)
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> [LEpaComment]
-> [CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs))]
forall a.
(a -> Maybe RealSrcSpan)
-> [a] -> [LEpaComment] -> [CommentGroup a]
commentGroups
            (SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan (SrcSpan -> Maybe RealSrcSpan)
-> (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> SrcSpan)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDecl GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA)
            (HsDataDefn GhcPs -> [LConDecl GhcPs]
getConDecls HsDataDefn GhcPs
defn)
            (DataDecl -> [LEpaComment]
dataComments DataDecl
decl)

        onelineEnum :: Bool
onelineEnum =
            DataDecl -> Bool
isEnum DataDecl
decl Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
cBreakEnums Bool -> Bool -> Bool
&&
            (CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool)
-> [CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool)
-> (CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool)
-> CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool
forall a. CommentGroup a -> Bool
commentGroupHasComments) [CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs))]
constructorComments

    [Char] -> Printer ()
putText ([Char] -> Printer ()) -> [Char] -> Printer ()
forall a b. (a -> b) -> a -> b
$ DataDecl -> [Char]
newOrData DataDecl
decl
    Printer ()
space
    DataDecl -> Printer ()
putName DataDecl
decl

    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DataDecl -> Bool
isGADT DataDecl
decl) (Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Printer ()
putText [Char]
"where")

    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DataDecl -> Bool
hasConstructors DataDecl
decl) do
        case (Indent
cEquals, Indent
cFirstField) of
            (Indent
_, Indent Int
x) | DataDecl -> Bool
isEnum DataDecl
decl Bool -> Bool -> Bool
&& Bool
cBreakEnums -> Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
spaces Int
x
            (Indent
_, Indent
_)
                | Bool -> Bool
not (DataDecl -> Bool
isNewtype DataDecl
decl)
                , DataDecl -> Bool
singleConstructor DataDecl
decl Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
cBreakSingleConstructors ->
                    Printer ()
space
            (Indent Int
x, Indent
_)
                | Bool
onelineEnum -> Printer ()
space
                | Bool
otherwise -> Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
spaces Int
x
            (Indent
SameLine, Indent
_) -> Printer ()
space

        Int
lineLengthAfterEq <- (Int -> Int) -> Printer Int -> Printer Int
forall a b. (a -> b) -> Printer a -> Printer b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2) Printer Int
getCurrentLineLength

        if  | Bool
onelineEnum ->
                [Char] -> Printer ()
putText [Char]
"=" 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 Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Config -> DataDecl -> Printer ()
putUnbrokenEnum Config
cfg DataDecl
decl
            | DataDecl -> Bool
isNewtype DataDecl
decl -> do
                [Char] -> Printer ()
putText [Char]
"=" 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
                DataDefnCons (LConDecl GhcPs)
-> (LConDecl GhcPs -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
GHC.dd_cons HsDataDefn GhcPs
defn) ((LConDecl GhcPs -> Printer ()) -> Printer ())
-> (LConDecl GhcPs -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Config -> LConDecl GhcPs -> Printer ()
putNewtypeConstructor Config
cfg
            | Bool -> Bool
not (Bool -> Bool)
-> (DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool)
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool
forall a. DataDefnCons a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool)
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool
forall a b. (a -> b) -> a -> b
$ HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
GHC.dd_cons HsDataDefn GhcPs
defn -> do
                [(CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs)), Bool,
  Bool)]
-> ((CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs)), Bool,
     Bool)
    -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs))]
-> [(CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs)), Bool,
     Bool)]
forall a. [a] -> [(a, Bool, Bool)]
flagEnds [CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs))]
constructorComments) (((CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs)), Bool,
   Bool)
  -> Printer ())
 -> Printer ())
-> ((CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs)), Bool,
     Bool)
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \(CommentGroup {[(GenLocated SrcSpanAnnA (ConDecl GhcPs), Maybe LEpaComment)]
[LEpaComment]
Block [Char]
cgBlock :: Block [Char]
cgPrior :: [LEpaComment]
cgItems :: [(GenLocated SrcSpanAnnA (ConDecl GhcPs), Maybe LEpaComment)]
cgFollowing :: [LEpaComment]
cgBlock :: forall a. CommentGroup a -> Block [Char]
cgPrior :: forall a. CommentGroup a -> [LEpaComment]
cgItems :: forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgFollowing :: forall a. CommentGroup a -> [LEpaComment]
..}, Bool
firstGroup, Bool
lastGroup) -> do
                    [LEpaComment] -> (LEpaComment -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LEpaComment]
cgPrior ((LEpaComment -> Printer ()) -> Printer ())
-> (LEpaComment -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \LEpaComment
lc -> do
                        EpaComment -> Printer ()
putComment (EpaComment -> Printer ()) -> EpaComment -> Printer ()
forall a b. (a -> b) -> a -> b
$ LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
GHC.unLoc LEpaComment
lc
                        Int -> Printer ()
consIndent Int
lineLengthAfterEq

                    [((GenLocated SrcSpanAnnA (ConDecl GhcPs), Maybe LEpaComment),
  Bool, Bool)]
-> (((GenLocated SrcSpanAnnA (ConDecl GhcPs), Maybe LEpaComment),
     Bool, Bool)
    -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(GenLocated SrcSpanAnnA (ConDecl GhcPs), Maybe LEpaComment)]
-> [((GenLocated SrcSpanAnnA (ConDecl GhcPs), Maybe LEpaComment),
     Bool, Bool)]
forall a. [a] -> [(a, Bool, Bool)]
flagEnds [(GenLocated SrcSpanAnnA (ConDecl GhcPs), Maybe LEpaComment)]
cgItems) ((((GenLocated SrcSpanAnnA (ConDecl GhcPs), Maybe LEpaComment),
   Bool, Bool)
  -> Printer ())
 -> Printer ())
-> (((GenLocated SrcSpanAnnA (ConDecl GhcPs), Maybe LEpaComment),
     Bool, Bool)
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \((GenLocated SrcSpanAnnA (ConDecl GhcPs)
lcon, Maybe LEpaComment
mbInlineComment), Bool
firstItem, Bool
lastItem) -> do
                        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DataDecl -> Bool
isGADT DataDecl
decl) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ do
                            [Char] -> Printer ()
putText ([Char] -> Printer ()) -> [Char] -> Printer ()
forall a b. (a -> b) -> a -> b
$ if Bool
firstGroup Bool -> Bool -> Bool
&& Bool
firstItem then [Char]
"=" else [Char]
"|"
                            Printer ()
space
                        Config -> Int -> LConDecl GhcPs -> Printer ()
putConstructor Config
cfg Int
lineLengthAfterEq LConDecl GhcPs
GenLocated SrcSpanAnnA (ConDecl GhcPs)
lcon
                        Maybe EpaComment -> Printer ()
putMaybeLineComment (Maybe EpaComment -> Printer ()) -> Maybe EpaComment -> Printer ()
forall a b. (a -> b) -> a -> b
$ LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
GHC.unLoc (LEpaComment -> EpaComment)
-> Maybe LEpaComment -> Maybe EpaComment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe LEpaComment
mbInlineComment
                        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
lastGroup Bool -> Bool -> Bool
&& Bool
lastItem) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
                            Int -> Printer ()
consIndent Int
lineLengthAfterEq

                    [LEpaComment] -> (LEpaComment -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LEpaComment]
cgFollowing ((LEpaComment -> Printer ()) -> Printer ())
-> (LEpaComment -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \LEpaComment
lc -> do
                        Int -> Printer ()
consIndent Int
lineLengthAfterEq
                        EpaComment -> Printer ()
putComment (EpaComment -> Printer ()) -> EpaComment -> Printer ()
forall a b. (a -> b) -> a -> b
$ LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
GHC.unLoc LEpaComment
lc

            | Bool
otherwise ->
                () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    let derivingComments :: [LEpaComment]
derivingComments = [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
-> [LEpaComment]
forall a. (Data a, Typeable a) => a -> [LEpaComment]
deepAnnComments (HsDataDefn GhcPs -> HsDeriving GhcPs
forall pass. HsDataDefn pass -> HsDeriving pass
GHC.dd_derivs HsDataDefn GhcPs
defn)

    Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DataDecl -> Bool
hasDeriving DataDecl
decl) do
        if Bool
onelineEnum Bool -> Bool -> Bool
&& [LEpaComment] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LEpaComment]
derivingComments then do
            Printer ()
newline
            Int -> Printer ()
spaces Int
cDeriving
        else do
            [LEpaComment] -> (LEpaComment -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LEpaComment]
derivingComments ((LEpaComment -> Printer ()) -> Printer ())
-> (LEpaComment -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \LEpaComment
lc -> do
                Printer ()
newline
                Int -> Printer ()
spaces Int
cDeriving
                EpaComment -> Printer ()
putComment (EpaComment -> Printer ()) -> EpaComment -> Printer ()
forall a b. (a -> b) -> a -> b
$ LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
GHC.unLoc LEpaComment
lc
            Printer ()
newline
            Int -> Printer ()
spaces Int
cDeriving

        Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep (Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
spaces Int
cDeriving) ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)
 -> Printer ())
-> [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
map
            (Config -> LHsDerivingClause GhcPs -> Printer ()
putDeriving Config
cfg)
            (HsDataDefn GhcPs -> HsDeriving GhcPs
forall pass. HsDataDefn pass -> HsDeriving pass
GHC.dd_derivs HsDataDefn GhcPs
defn)
  where
    consIndent :: Int -> Printer ()
consIndent Int
eqIndent = Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> case (Indent
cEquals, Indent
cFirstField) of
        (Indent
SameLine, Indent
SameLine) -> Int -> Printer ()
spaces (Int
eqIndent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
        (Indent
SameLine, Indent Int
y) -> Int -> Printer ()
spaces (Int
eqIndent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
        (Indent Int
x, Indent Int
_) -> Int -> Printer ()
spaces Int
x
        (Indent Int
x, Indent
SameLine) -> Int -> Printer ()
spaces Int
x

derivingClauseTypes
    :: GHC.HsDerivingClause GHC.GhcPs -> [GHC.LHsSigType GHC.GhcPs]
derivingClauseTypes :: HsDerivingClause GhcPs -> [LHsSigType GhcPs]
derivingClauseTypes 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_ext :: forall pass. HsDerivingClause pass -> XCHsDerivingClause pass
deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
..} =
    case GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
-> DerivClauseTys GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LDerivClauseTys GhcPs
GenLocated SrcSpanAnnC (DerivClauseTys GhcPs)
deriv_clause_tys of
        GHC.DctSingle XDctSingle GhcPs
_ LHsSigType GhcPs
t -> [LHsSigType GhcPs
t]
        GHC.DctMulti XDctMulti GhcPs
_ [LHsSigType GhcPs]
ts -> [LHsSigType GhcPs]
ts

putDeriving :: Config -> GHC.LHsDerivingClause GHC.GhcPs -> P ()
putDeriving :: Config -> LHsDerivingClause GhcPs -> Printer ()
putDeriving Config{Bool
Int
MaxColumns
Indent
cEquals :: Config -> Indent
cFirstField :: Config -> Indent
cFieldComment :: Config -> Int
cDeriving :: Config -> Int
cBreakEnums :: Config -> Bool
cBreakSingleConstructors :: Config -> Bool
cVia :: Config -> Indent
cCurriedContext :: Config -> Bool
cSortDeriving :: Config -> Bool
cMaxColumns :: Config -> MaxColumns
cEquals :: Indent
cFirstField :: Indent
cFieldComment :: Int
cDeriving :: Int
cBreakEnums :: Bool
cBreakSingleConstructors :: Bool
cVia :: Indent
cCurriedContext :: Bool
cSortDeriving :: Bool
cMaxColumns :: MaxColumns
..} LHsDerivingClause GhcPs
lclause = do
    let clause :: HsDerivingClause GhcPs
clause@GHC.HsDerivingClause {Maybe (LDerivStrategy GhcPs)
XCHsDerivingClause GhcPs
LDerivClauseTys GhcPs
deriv_clause_ext :: forall pass. HsDerivingClause pass -> XCHsDerivingClause pass
deriv_clause_strategy :: forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_tys :: forall pass. HsDerivingClause pass -> LDerivClauseTys pass
deriv_clause_ext :: XCHsDerivingClause GhcPs
deriv_clause_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_clause_tys :: LDerivClauseTys GhcPs
..} = GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)
-> HsDerivingClause GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LHsDerivingClause GhcPs
GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)
lclause
        tys :: [GenLocated SrcSpanAnnA (HsType GhcPs)]
tys = (if Bool
cSortDeriving then (GenLocated SrcSpanAnnA (HsType GhcPs)
 -> GenLocated SrcSpanAnnA (HsType GhcPs) -> Ordering)
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy GenLocated SrcSpanAnnA (HsType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs) -> Ordering
forall a. Outputable a => a -> a -> Ordering
compareOutputableCI else [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. a -> a
id) ([GenLocated SrcSpanAnnA (HsType GhcPs)]
 -> [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a b. (a -> b) -> a -> b
$
            (LHsSigType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> [LHsSigType GhcPs] -> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (HsSigType GhcPs -> LHsType GhcPs
HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass. HsSigType pass -> LHsType pass
GHC.sig_body (HsSigType GhcPs -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> (GenLocated SrcSpanAnnA (HsSigType GhcPs) -> HsSigType GhcPs)
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsSigType GhcPs) -> HsSigType GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc) ([LHsSigType GhcPs] -> [GenLocated SrcSpanAnnA (HsType GhcPs)])
-> [LHsSigType GhcPs] -> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a b. (a -> b) -> a -> b
$
            HsDerivingClause GhcPs -> [LHsSigType GhcPs]
derivingClauseTypes HsDerivingClause GhcPs
clause
        headTy :: Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
headTy = [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
forall a. [a] -> Maybe a
listToMaybe [GenLocated SrcSpanAnnA (HsType GhcPs)]
tys
        tailTy :: [GenLocated SrcSpanAnnA (HsType GhcPs)]
tailTy = Int
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall a. Int -> [a] -> [a]
drop Int
1 [GenLocated SrcSpanAnnA (HsType GhcPs)]
tys

    [Char] -> Printer ()
putText [Char]
"deriving"

    Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
-> (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
    -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
deriv_clause_strategy ((GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs) -> Printer ())
 -> Printer ())
-> (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
lstrat -> case GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
-> DerivStrategy GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
lstrat of
        GHC.StockStrategy    {} -> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Printer ()
putText [Char]
"stock"
        GHC.AnyclassStrategy {} -> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Printer ()
putText [Char]
"anyclass"
        GHC.NewtypeStrategy  {} -> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Printer ()
putText [Char]
"newtype"
        GHC.ViaStrategy      {} -> () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    (PrinterState -> Bool) -> Printer () -> Printer () -> Printer ()
forall b. (PrinterState -> Bool) -> P b -> P b -> P b
putCond
        PrinterState -> Bool
withinColumns
        do
            Printer ()
space
            [Char] -> Printer ()
putText [Char]
"("
            Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep
                (Printer ()
comma 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)
                ((GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable [GenLocated SrcSpanAnnA (HsType GhcPs)]
tys)
            [Char] -> Printer ()
putText [Char]
")"
        do
            Printer ()
newline
            Int -> Printer ()
spaces Int
indentation
            [Char] -> Printer ()
putText [Char]
"("

            Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
headTy \GenLocated SrcSpanAnnA (HsType GhcPs)
t ->
                Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable GenLocated SrcSpanAnnA (HsType GhcPs)
t

            [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [GenLocated SrcSpanAnnA (HsType GhcPs)]
tailTy \GenLocated SrcSpanAnnA (HsType GhcPs)
t -> do
                Printer ()
newline
                Int -> Printer ()
spaces Int
indentation
                Printer ()
comma
                Printer ()
space
                GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable GenLocated SrcSpanAnnA (HsType GhcPs)
t

            Printer ()
newline
            Int -> Printer ()
spaces Int
indentation
            [Char] -> Printer ()
putText [Char]
")"

    Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
-> (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
    -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs))
deriv_clause_strategy ((GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs) -> Printer ())
 -> Printer ())
-> (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
lstrat -> case GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
-> DerivStrategy GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
lstrat of
        GHC.ViaStrategy XViaStrategy GhcPs
tp -> do
            case Indent
cVia of
                Indent
SameLine -> Printer ()
space
                Indent Int
x -> Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
spaces (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cDeriving)

            [Char] -> Printer ()
putText [Char]
"via"
            Printer ()
space
            LHsType GhcPs -> Printer ()
putType (LHsType GhcPs -> Printer ()) -> LHsType GhcPs -> Printer ()
forall a b. (a -> b) -> a -> b
$ case XViaStrategy GhcPs
tp of
                GHC.XViaStrategyPs EpAnn [AddEpAnn]
_ LHsSigType GhcPs
ty -> HsSigType GhcPs -> LHsType GhcPs
forall pass. HsSigType pass -> LHsType pass
GHC.sig_body (HsSigType GhcPs -> LHsType GhcPs)
-> HsSigType GhcPs -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsSigType GhcPs) -> HsSigType GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LHsSigType GhcPs
GenLocated SrcSpanAnnA (HsSigType GhcPs)
ty
        DerivStrategy GhcPs
_ -> () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    -- putEolComment pos
  where
    withinColumns :: PrinterState -> Bool
withinColumns PrinterState{[Char]
currentLine :: [Char]
currentLine :: PrinterState -> [Char]
currentLine} =
      case MaxColumns
cMaxColumns of
        MaxColumns Int
maxCols -> [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
currentLine Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxCols
        MaxColumns
NoMaxColumns       -> Bool
True

    indentation :: Int
indentation =
      Int
cDeriving Int -> Int -> Int
forall a. Num a => a -> a -> a
+ case Indent
cFirstField of
        Indent Int
x -> Int
x
        Indent
SameLine -> Int
0

putUnbrokenEnum :: Config -> DataDecl -> P ()
putUnbrokenEnum :: Config -> DataDecl -> Printer ()
putUnbrokenEnum Config
cfg DataDecl
decl = Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep
    (Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Printer ()
putText [Char]
"|" 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)
    ((GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Config -> Int -> LConDecl GhcPs -> Printer ()
putConstructor Config
cfg Int
0) ([GenLocated SrcSpanAnnA (ConDecl GhcPs)] -> [Printer ()])
-> (DataDecl -> [GenLocated SrcSpanAnnA (ConDecl GhcPs)])
-> DataDecl
-> [Printer ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> [LConDecl GhcPs]
HsDataDefn GhcPs -> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
getConDecls (HsDataDefn GhcPs -> [GenLocated SrcSpanAnnA (ConDecl GhcPs)])
-> (DataDecl -> HsDataDefn GhcPs)
-> DataDecl
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDecl -> HsDataDefn GhcPs
dataDefn (DataDecl -> [Printer ()]) -> DataDecl -> [Printer ()]
forall a b. (a -> b) -> a -> b
$ DataDecl
decl)

putName :: DataDecl -> P ()
putName :: DataDecl -> Printer ()
putName decl :: DataDecl
decl@MkDataDecl{[LEpaComment]
GenLocated SrcSpanAnnN RdrName
RealSrcSpan
LexicalFixity
LHsQTyVars GhcPs
HsDataDefn GhcPs
dataComments :: DataDecl -> [LEpaComment]
dataLoc :: DataDecl -> RealSrcSpan
dataDeclName :: DataDecl -> GenLocated SrcSpanAnnN RdrName
dataTypeVars :: DataDecl -> LHsQTyVars GhcPs
dataDefn :: DataDecl -> HsDataDefn GhcPs
dataFixity :: DataDecl -> LexicalFixity
dataComments :: [LEpaComment]
dataLoc :: RealSrcSpan
dataDeclName :: GenLocated SrcSpanAnnN RdrName
dataTypeVars :: LHsQTyVars GhcPs
dataDefn :: HsDataDefn GhcPs
dataFixity :: LexicalFixity
..} =
  if DataDecl -> Bool
isInfix DataDecl
decl then do
    Maybe
  (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
-> (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
    -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
Maybe
  (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
firstTvar (\GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
t -> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
t 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)
    GenLocated SrcSpanAnnN RdrName -> Printer ()
putRdrName GenLocated SrcSpanAnnN RdrName
dataDeclName
    Printer ()
space
    Maybe
  (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
-> (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
    -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
Maybe
  (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
secondTvar GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable
    Printer ()
maybePutKindSig
  else do
    GenLocated SrcSpanAnnN RdrName -> Printer ()
putRdrName GenLocated SrcSpanAnnN RdrName
dataDeclName
    [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
-> (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
    -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (LHsQTyVars GhcPs -> [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
GHC.hsq_explicit LHsQTyVars GhcPs
dataTypeVars) (\GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
t -> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
-> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)
t)
    Printer ()
maybePutKindSig

  where
    firstTvar :: Maybe (GHC.LHsTyVarBndr (GHC.HsBndrVis GHC.GhcPs) GHC.GhcPs)
    firstTvar :: Maybe (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
firstTvar = [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
-> Maybe (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall a. [a] -> Maybe a
listToMaybe ([LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
 -> Maybe (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs))
-> [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
-> Maybe (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsQTyVars GhcPs -> [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
GHC.hsq_explicit LHsQTyVars GhcPs
dataTypeVars

    secondTvar :: Maybe (GHC.LHsTyVarBndr (GHC.HsBndrVis GHC.GhcPs) GHC.GhcPs)
    secondTvar :: Maybe (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
secondTvar = [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
-> Maybe (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
[GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
-> Maybe
     (GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs))
forall a. [a] -> Maybe a
listToMaybe ([GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
 -> Maybe (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs))
-> ([GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
    -> [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)])
-> [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
-> Maybe (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
-> [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
forall a. Int -> [a] -> [a]
drop Int
1 ([GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
 -> Maybe (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs))
-> [GenLocated SrcSpanAnnA (HsTyVarBndr (HsBndrVis GhcPs) GhcPs)]
-> Maybe (LHsTyVarBndr (HsBndrVis GhcPs) GhcPs)
forall a b. (a -> b) -> a -> b
$ LHsQTyVars GhcPs -> [LHsTyVarBndr (HsBndrVis GhcPs) GhcPs]
forall pass.
LHsQTyVars pass -> [LHsTyVarBndr (HsBndrVis pass) pass]
GHC.hsq_explicit LHsQTyVars GhcPs
dataTypeVars

    maybePutKindSig :: Printer ()
    maybePutKindSig :: Printer ()
maybePutKindSig = Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
-> (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LHsType GhcPs)
Maybe (GenLocated SrcSpanAnnA (HsType GhcPs))
maybeKindSig (\GenLocated SrcSpanAnnA (HsType GhcPs)
k -> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Printer ()
putText [Char]
"::" 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 Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable GenLocated SrcSpanAnnA (HsType GhcPs)
k)

    maybeKindSig :: Maybe (GHC.LHsKind GHC.GhcPs)
    maybeKindSig :: Maybe (LHsType GhcPs)
maybeKindSig = HsDataDefn GhcPs -> Maybe (LHsType GhcPs)
forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
GHC.dd_kindSig HsDataDefn GhcPs
dataDefn

putConstructor :: Config -> Int -> GHC.LConDecl GHC.GhcPs -> P ()
putConstructor :: Config -> Int -> LConDecl GhcPs -> Printer ()
putConstructor Config
cfg Int
consIndent LConDecl GhcPs
lcons = case GenLocated SrcSpanAnnA (ConDecl GhcPs) -> ConDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LConDecl GhcPs
GenLocated SrcSpanAnnA (ConDecl GhcPs)
lcons of
  GHC.ConDeclGADT {Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
NonEmpty (LIdP GhcPs)
XConDeclGADT GhcPs
LHsUniToken "::" "\8759" GhcPs
LHsType GhcPs
XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
HsConDeclGADTDetails GhcPs
con_g_ext :: XConDeclGADT GhcPs
con_names :: NonEmpty (LIdP GhcPs)
con_dcolon :: LHsUniToken "::" "\8759" GhcPs
con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_g_args :: HsConDeclGADTDetails GhcPs
con_res_ty :: LHsType GhcPs
con_doc :: Maybe (LHsDoc GhcPs)
con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
con_names :: forall pass. ConDecl pass -> NonEmpty (LIdP pass)
con_dcolon :: forall pass. ConDecl pass -> LHsUniToken "::" "\8759" pass
con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
..} -> do
    -- Put argument to constructor first:
    case HsConDeclGADTDetails GhcPs
con_g_args of
      GHC.PrefixConGADT [HsScaled GhcPs (LHsType GhcPs)]
_ -> Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep (Printer ()
comma 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) ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnN RdrName -> Printer ())
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> Printer ()
putRdrName ([GenLocated SrcSpanAnnN RdrName] -> [Printer ()])
-> [GenLocated SrcSpanAnnN RdrName] -> [Printer ()]
forall a b. (a -> b) -> a -> b
$ NonEmpty (GenLocated SrcSpanAnnN RdrName)
-> [GenLocated SrcSpanAnnN RdrName]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (LIdP GhcPs)
NonEmpty (GenLocated SrcSpanAnnN RdrName)
con_names
      GHC.RecConGADT XRec GhcPs [LConDeclField GhcPs]
_ LHsUniToken "->" "\8594" GhcPs
_ -> [Char] -> Printer ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> Printer ()) -> (Lines -> [Char]) -> Lines -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> [Char]
forall a. Monoid a => [a] -> a
mconcat (Lines -> Printer ()) -> Lines -> Printer ()
forall a b. (a -> b) -> a -> b
$
          [ [Char]
"Language.Haskell.Stylish.Step.Data.putConstructor: "
          , [Char]
"encountered a GADT with record constructors, not supported yet"
          ]

    -- Put type of constructor:
    Printer ()
space
    [Char] -> Printer ()
putText [Char]
"::"
    Printer ()
space

    Bool -> [LHsTyVarBndr Specificity GhcPs] -> Printer ()
forall s.
OutputableBndrFlag s 'Parsed =>
Bool -> [LHsTyVarBndr s GhcPs] -> Printer ()
putForAll
        (case GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
-> HsOuterSigTyVarBndrs GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
con_bndrs of
            GHC.HsOuterImplicit {} -> Bool
False
            GHC.HsOuterExplicit {} -> Bool
True)
        (case GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
-> HsOuterSigTyVarBndrs GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
GenLocated SrcSpanAnnA (HsOuterSigTyVarBndrs GhcPs)
con_bndrs of
            GHC.HsOuterImplicit {}   -> []
            GHC.HsOuterExplicit {[LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
XHsOuterExplicit GhcPs Specificity
hso_xexplicit :: XHsOuterExplicit GhcPs Specificity
hso_bndrs :: [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
hso_xexplicit :: forall flag pass.
HsOuterTyVarBndrs flag pass -> XHsOuterExplicit pass flag
hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
..} -> [LHsTyVarBndr Specificity (NoGhcTc GhcPs)]
[LHsTyVarBndr Specificity GhcPs]
hso_bndrs)
    Maybe (LHsContext GhcPs)
-> (LHsContext GhcPs -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LHsContext GhcPs)
con_mb_cxt ((LHsContext GhcPs -> Printer ()) -> Printer ())
-> (LHsContext GhcPs -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Config -> LHsContext GhcPs -> Printer ()
putContext Config
cfg
    case HsConDeclGADTDetails GhcPs
con_g_args of
        GHC.PrefixConGADT [HsScaled GhcPs (LHsType GhcPs)]
scaledTys -> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [HsScaled GhcPs (LHsType GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
scaledTys ((HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
  -> Printer ())
 -> Printer ())
-> (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
scaledTy -> do
            LHsType GhcPs -> Printer ()
putType (LHsType GhcPs -> Printer ()) -> LHsType GhcPs -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass a. HsScaled pass a -> a
GHC.hsScaledThing HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
scaledTy
            Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Printer ()
putText [Char]
"->" 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
        GHC.RecConGADT XRec GhcPs [LConDeclField GhcPs]
_ LHsUniToken "->" "\8594" GhcPs
_ -> [Char] -> Printer ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> Printer ()) -> (Lines -> [Char]) -> Lines -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> [Char]
forall a. Monoid a => [a] -> a
mconcat (Lines -> Printer ()) -> Lines -> Printer ()
forall a b. (a -> b) -> a -> b
$
            [ [Char]
"Language.Haskell.Stylish.Step.Data.putConstructor: "
            , [Char]
"encountered a GADT with record constructors, not supported yet"
            ]
    LHsType GhcPs -> Printer ()
putType LHsType GhcPs
con_res_ty

  GHC.ConDeclH98 {Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDeclH98Details GhcPs
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
con_forall :: Bool
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_args :: HsConDeclH98Details GhcPs
con_doc :: Maybe (LHsDoc GhcPs)
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> LIdP pass
con_forall :: forall pass. ConDecl pass -> Bool
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
..} -> do
    Bool -> [LHsTyVarBndr Specificity GhcPs] -> Printer ()
forall s.
OutputableBndrFlag s 'Parsed =>
Bool -> [LHsTyVarBndr s GhcPs] -> Printer ()
putForAll Bool
con_forall [LHsTyVarBndr Specificity GhcPs]
con_ex_tvs
    Maybe (LHsContext GhcPs)
-> (LHsContext GhcPs -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (LHsContext GhcPs)
con_mb_cxt ((LHsContext GhcPs -> Printer ()) -> Printer ())
-> (LHsContext GhcPs -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ Config -> LHsContext GhcPs -> Printer ()
putContext Config
cfg
    case HsConDeclH98Details GhcPs
con_args of
      GHC.InfixCon HsScaled GhcPs (LHsType GhcPs)
arg1 HsScaled GhcPs (LHsType GhcPs)
arg2 -> do
        LHsType GhcPs -> Printer ()
putType (LHsType GhcPs -> Printer ()) -> LHsType GhcPs -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass a. HsScaled pass a -> a
GHC.hsScaledThing HsScaled GhcPs (LHsType GhcPs)
HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
arg1
        Printer ()
space
        GenLocated SrcSpanAnnN RdrName -> Printer ()
putRdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
con_name
        Printer ()
space
        LHsType GhcPs -> Printer ()
putType (LHsType GhcPs -> Printer ()) -> LHsType GhcPs -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass a. HsScaled pass a -> a
GHC.hsScaledThing HsScaled GhcPs (LHsType GhcPs)
HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
arg2
      GHC.PrefixCon [Void]
_tyargs [HsScaled GhcPs (LHsType GhcPs)]
args -> do
        GenLocated SrcSpanAnnN RdrName -> Printer ()
putRdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
con_name
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsScaled GhcPs (LHsType GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
args) Printer ()
space
        Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep Printer ()
space ((HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Printer ())
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass a. HsScaled pass a -> a
GHC.hsScaledThing) [HsScaled GhcPs (LHsType GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
args)
      GHC.RecCon XRec GhcPs [LConDeclField GhcPs]
largs | GenLocated SrcSpanAnnA (ConDeclField GhcPs)
_ : [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
_ <- GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall l e. GenLocated l e -> e
GHC.unLoc XRec GhcPs [LConDeclField GhcPs]
GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
largs -> do
        GenLocated SrcSpanAnnN RdrName -> Printer ()
putRdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
con_name
        Printer ()
skipToBrace
        Int
bracePos <- Printer Int
getCurrentLineLength
        [Char] -> Printer ()
putText [Char]
"{"
        let fieldPos :: Int
fieldPos = Int
bracePos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        Printer ()
space

        let commented :: [CommentGroup (GenLocated SrcSpanAnnA (ConDeclField GhcPs))]
commented = (GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> Maybe RealSrcSpan)
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> [LEpaComment]
-> [CommentGroup (GenLocated SrcSpanAnnA (ConDeclField GhcPs))]
forall a.
(a -> Maybe RealSrcSpan)
-> [a] -> [LEpaComment] -> [CommentGroup a]
commentGroups
                (SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan (SrcSpan -> Maybe RealSrcSpan)
-> (GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> SrcSpan)
-> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
-> Maybe RealSrcSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA)
                (GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall l e. GenLocated l e -> e
GHC.unLoc XRec GhcPs [LConDeclField GhcPs]
GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
largs)
                (EpAnn AnnList -> [LEpaComment]
forall a. EpAnn a -> [LEpaComment]
epAnnComments (EpAnn AnnList -> [LEpaComment])
-> (SrcSpanAnnL -> EpAnn AnnList) -> SrcSpanAnnL -> [LEpaComment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpanAnnL -> EpAnn AnnList
forall a. SrcSpanAnn' a -> a
GHC.ann (SrcSpanAnnL -> [LEpaComment]) -> SrcSpanAnnL -> [LEpaComment]
forall a b. (a -> b) -> a -> b
$ GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> SrcSpanAnnL
forall l e. GenLocated l e -> l
GHC.getLoc XRec GhcPs [LConDeclField GhcPs]
GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
largs)

        [(CommentGroup (GenLocated SrcSpanAnnA (ConDeclField GhcPs)), Bool,
  Bool)]
-> ((CommentGroup (GenLocated SrcSpanAnnA (ConDeclField GhcPs)),
     Bool, Bool)
    -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([CommentGroup (GenLocated SrcSpanAnnA (ConDeclField GhcPs))]
-> [(CommentGroup (GenLocated SrcSpanAnnA (ConDeclField GhcPs)),
     Bool, Bool)]
forall a. [a] -> [(a, Bool, Bool)]
flagEnds [CommentGroup (GenLocated SrcSpanAnnA (ConDeclField GhcPs))]
commented) (((CommentGroup (GenLocated SrcSpanAnnA (ConDeclField GhcPs)),
   Bool, Bool)
  -> Printer ())
 -> Printer ())
-> ((CommentGroup (GenLocated SrcSpanAnnA (ConDeclField GhcPs)),
     Bool, Bool)
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \(CommentGroup {[(GenLocated SrcSpanAnnA (ConDeclField GhcPs), Maybe LEpaComment)]
[LEpaComment]
Block [Char]
cgBlock :: forall a. CommentGroup a -> Block [Char]
cgPrior :: forall a. CommentGroup a -> [LEpaComment]
cgItems :: forall a. CommentGroup a -> [(a, Maybe LEpaComment)]
cgFollowing :: forall a. CommentGroup a -> [LEpaComment]
cgBlock :: Block [Char]
cgPrior :: [LEpaComment]
cgItems :: [(GenLocated SrcSpanAnnA (ConDeclField GhcPs), Maybe LEpaComment)]
cgFollowing :: [LEpaComment]
..}, Bool
firstCommentGroup, Bool
_) -> do

        -- Unless everything's configured to be on the same line, put pending
        -- comments
          [LEpaComment] -> (LEpaComment -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LEpaComment]
cgPrior ((LEpaComment -> Printer ()) -> Printer ())
-> (LEpaComment -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \LEpaComment
lc -> do
            Int -> Printer ()
pad Int
fieldPos
            EpaComment -> Printer ()
putComment (EpaComment -> Printer ()) -> EpaComment -> Printer ()
forall a b. (a -> b) -> a -> b
$ LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
GHC.unLoc LEpaComment
lc
            Int -> Printer ()
sepDecl Int
bracePos

          [((GenLocated SrcSpanAnnA (ConDeclField GhcPs), Maybe LEpaComment),
  Bool, Bool)]
-> (((GenLocated SrcSpanAnnA (ConDeclField GhcPs),
      Maybe LEpaComment),
     Bool, Bool)
    -> Printer ())
-> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(GenLocated SrcSpanAnnA (ConDeclField GhcPs), Maybe LEpaComment)]
-> [((GenLocated SrcSpanAnnA (ConDeclField GhcPs),
      Maybe LEpaComment),
     Bool, Bool)]
forall a. [a] -> [(a, Bool, Bool)]
flagEnds [(GenLocated SrcSpanAnnA (ConDeclField GhcPs), Maybe LEpaComment)]
cgItems) ((((GenLocated SrcSpanAnnA (ConDeclField GhcPs),
    Maybe LEpaComment),
   Bool, Bool)
  -> Printer ())
 -> Printer ())
-> (((GenLocated SrcSpanAnnA (ConDeclField GhcPs),
      Maybe LEpaComment),
     Bool, Bool)
    -> Printer ())
-> Printer ()
forall a b. (a -> b) -> a -> b
$ \((GenLocated SrcSpanAnnA (ConDeclField GhcPs)
item, Maybe LEpaComment
mbInlineComment), Bool
firstItem, Bool
_) -> do
            if Bool
firstCommentGroup Bool -> Bool -> Bool
&& Bool
firstItem
                then Int -> Printer ()
pad Int
fieldPos
                else do
                    Printer ()
comma
                    Printer ()
space
            Config -> ConDeclField GhcPs -> Printer ()
putConDeclField Config
cfg (ConDeclField GhcPs -> Printer ())
-> ConDeclField GhcPs -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> ConDeclField GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (ConDeclField GhcPs)
item
            case Maybe LEpaComment
mbInlineComment of
                Just LEpaComment
c -> do
                    Int -> Printer ()
sepDecl Int
bracePos Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
spaces (Config -> Int
cFieldComment Config
cfg)
                    EpaComment -> Printer ()
putComment (EpaComment -> Printer ()) -> EpaComment -> Printer ()
forall a b. (a -> b) -> a -> b
$ LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
GHC.unLoc LEpaComment
c
                Maybe LEpaComment
_ -> () -> Printer ()
forall a. a -> Printer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            Int -> Printer ()
sepDecl Int
bracePos

          [LEpaComment] -> (LEpaComment -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LEpaComment]
cgFollowing ((LEpaComment -> Printer ()) -> Printer ())
-> (LEpaComment -> Printer ()) -> Printer ()
forall a b. (a -> b) -> a -> b
$ \LEpaComment
lc -> do
            Int -> Printer ()
spaces (Int -> Printer ()) -> Int -> Printer ()
forall a b. (a -> b) -> a -> b
$ Config -> Int
cFieldComment Config
cfg
            EpaComment -> Printer ()
putComment (EpaComment -> Printer ()) -> EpaComment -> Printer ()
forall a b. (a -> b) -> a -> b
$ LEpaComment -> EpaComment
forall l e. GenLocated l e -> e
GHC.unLoc LEpaComment
lc
            Int -> Printer ()
sepDecl Int
bracePos

        -- Print whitespace to closing brace
        [Char] -> Printer ()
putText [Char]
"}"
      GHC.RecCon XRec GhcPs [LConDeclField GhcPs]
_ -> do
        Printer ()
skipToBrace Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Printer ()
putText [Char]
"{"
        Printer ()
skipToBrace Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Printer ()
putText [Char]
"}"

    where
      -- Jump to the first brace of the first record of the first constructor.
      skipToBrace :: Printer ()
skipToBrace = case (Config -> Indent
cEquals Config
cfg, Config -> Indent
cFirstField Config
cfg) of
        (Indent
_, Indent Int
y) | Bool -> Bool
not (Config -> Bool
cBreakSingleConstructors Config
cfg) -> Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
spaces Int
y
        (Indent
SameLine, Indent
SameLine) -> Printer ()
space
        (Indent Int
x, Indent Int
y) -> Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
spaces (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)
        (Indent
SameLine, Indent Int
y) -> Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
spaces (Int
consIndent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y)
        (Indent Int
_, Indent
SameLine) -> Printer ()
space

      -- Jump to the next declaration.
      sepDecl :: Int -> Printer ()
sepDecl Int
bracePos = Printer ()
newline Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
spaces case (Config -> Indent
cEquals Config
cfg, Config -> Indent
cFirstField Config
cfg) of
        (Indent
_, Indent Int
y) | Bool -> Bool
not (Config -> Bool
cBreakSingleConstructors Config
cfg) -> Int
y
        (Indent
SameLine, Indent
SameLine)                               -> Int
bracePos
        (Indent Int
x, Indent Int
y)                               -> Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        (Indent
SameLine, Indent Int
y)                               -> Int
bracePos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
        (Indent Int
x, Indent
SameLine)                               -> Int
bracePos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2

putNewtypeConstructor :: Config -> GHC.LConDecl GHC.GhcPs -> P ()
putNewtypeConstructor :: Config -> LConDecl GhcPs -> Printer ()
putNewtypeConstructor Config
cfg LConDecl GhcPs
lcons = case GenLocated SrcSpanAnnA (ConDecl GhcPs) -> ConDecl GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LConDecl GhcPs
GenLocated SrcSpanAnnA (ConDecl GhcPs)
lcons of
  GHC.ConDeclH98{Bool
[LHsTyVarBndr Specificity GhcPs]
Maybe (LHsContext GhcPs)
Maybe (LHsDoc GhcPs)
XConDeclH98 GhcPs
LIdP GhcPs
HsConDeclH98Details GhcPs
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> LIdP pass
con_forall :: forall pass. ConDecl pass -> Bool
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_ext :: XConDeclH98 GhcPs
con_name :: LIdP GhcPs
con_forall :: Bool
con_ex_tvs :: [LHsTyVarBndr Specificity GhcPs]
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_args :: HsConDeclH98Details GhcPs
con_doc :: Maybe (LHsDoc GhcPs)
..} ->
    GenLocated SrcSpanAnnN RdrName -> Printer ()
putRdrName LIdP GhcPs
GenLocated SrcSpanAnnN RdrName
con_name Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> case HsConDeclH98Details GhcPs
con_args of
      GHC.PrefixCon [Void]
_ [HsScaled GhcPs (LHsType GhcPs)]
args -> do
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsScaled GhcPs (LHsType GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
args) Printer ()
space
        Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep Printer ()
space ((HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> Printer ())
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable (GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> GenLocated SrcSpanAnnA (HsType GhcPs))
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
-> GenLocated SrcSpanAnnA (HsType GhcPs)
forall pass a. HsScaled pass a -> a
GHC.hsScaledThing) [HsScaled GhcPs (LHsType GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
args)
      GHC.RecCon XRec GhcPs [LConDeclField GhcPs]
largs | [GenLocated SrcSpanAnnA (ConDeclField GhcPs)
firstArg] <- GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall l e. GenLocated l e -> e
GHC.unLoc XRec GhcPs [LConDeclField GhcPs]
GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
largs -> do
        Printer ()
space
        [Char] -> Printer ()
putText [Char]
"{"
        Printer ()
space
        Config -> ConDeclField GhcPs -> Printer ()
putConDeclField Config
cfg (ConDeclField GhcPs -> Printer ())
-> ConDeclField GhcPs -> Printer ()
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (ConDeclField GhcPs) -> ConDeclField GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (ConDeclField GhcPs)
firstArg
        Printer ()
space
        [Char] -> Printer ()
putText [Char]
"}"
      GHC.RecCon {} ->
        [Char] -> Printer ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> Printer ()) -> (Lines -> [Char]) -> Lines -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> [Char]
forall a. Monoid a => [a] -> a
mconcat (Lines -> Printer ()) -> Lines -> Printer ()
forall a b. (a -> b) -> a -> b
$
          [ [Char]
"Language.Haskell.Stylish.Step.Data.putNewtypeConstructor: "
          , [Char]
"encountered newtype with several arguments"
          ]
      GHC.InfixCon {} ->
        [Char] -> Printer ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> Printer ()) -> (Lines -> [Char]) -> Lines -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> [Char]
forall a. Monoid a => [a] -> a
mconcat (Lines -> Printer ()) -> Lines -> Printer ()
forall a b. (a -> b) -> a -> b
$
          [ [Char]
"Language.Haskell.Stylish.Step.Data.putNewtypeConstructor: "
          , [Char]
"infix newtype constructor"
          ]
  GHC.ConDeclGADT{} ->
    [Char] -> Printer ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> Printer ()) -> (Lines -> [Char]) -> Lines -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> [Char]
forall a. Monoid a => [a] -> a
mconcat (Lines -> Printer ()) -> Lines -> Printer ()
forall a b. (a -> b) -> a -> b
$
      [ [Char]
"Language.Haskell.Stylish.Step.Data.putNewtypeConstructor: "
      , [Char]
"GADT encountered in newtype"
      ]

putForAll
    :: GHC.OutputableBndrFlag s 'GHC.Parsed
    => Bool -> [GHC.LHsTyVarBndr s GHC.GhcPs] -> P ()
putForAll :: forall s.
OutputableBndrFlag s 'Parsed =>
Bool -> [LHsTyVarBndr s GhcPs] -> Printer ()
putForAll Bool
frall [LHsTyVarBndr s GhcPs]
ex_tvs = Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
frall do
    [Char] -> Printer ()
putText [Char]
"forall"
    Printer ()
space
    Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ HsTyVarBndr s GhcPs -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable (HsTyVarBndr s GhcPs -> Printer ())
-> (GenLocated SrcSpanAnnA (HsTyVarBndr s GhcPs)
    -> HsTyVarBndr s GhcPs)
-> GenLocated SrcSpanAnnA (HsTyVarBndr s GhcPs)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr s GhcPs) -> HsTyVarBndr s GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc (GenLocated SrcSpanAnnA (HsTyVarBndr s GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr s GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsTyVarBndr s GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr s GhcPs)]
ex_tvs
    Printer ()
dot
    Printer ()
space

putContext :: Config -> GHC.LHsContext GHC.GhcPs -> P ()
putContext :: Config -> LHsContext GhcPs -> Printer ()
putContext Config{Bool
Int
MaxColumns
Indent
cEquals :: Config -> Indent
cFirstField :: Config -> Indent
cFieldComment :: Config -> Int
cDeriving :: Config -> Int
cBreakEnums :: Config -> Bool
cBreakSingleConstructors :: Config -> Bool
cVia :: Config -> Indent
cCurriedContext :: Config -> Bool
cSortDeriving :: Config -> Bool
cMaxColumns :: Config -> MaxColumns
cEquals :: Indent
cFirstField :: Indent
cFieldComment :: Int
cDeriving :: Int
cBreakEnums :: Bool
cBreakSingleConstructors :: Bool
cVia :: Indent
cCurriedContext :: Bool
cSortDeriving :: Bool
cMaxColumns :: MaxColumns
..} LHsContext GhcPs
lctx = Printer () -> Printer () -> Printer ()
forall a b. P a -> P b -> P a
suffix (Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Printer ()
putText [Char]
"=>" 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) (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$
    case [GenLocated SrcSpanAnnA (HsType GhcPs)]
ltys of
        [GenLocated SrcSpanAnnA (HsType GhcPs)
lty] | GHC.HsParTy XParTy GhcPs
_ LHsType GhcPs
tp <- GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (HsType GhcPs)
lty, Bool
cCurriedContext ->
          LHsType GhcPs -> Printer ()
putType LHsType GhcPs
tp
        [GenLocated SrcSpanAnnA (HsType GhcPs)
ctx] ->
          LHsType GhcPs -> Printer ()
putType LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
ctx
        [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxs | Bool
cCurriedContext ->
          Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep (Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Printer ()
putText [Char]
"=>" 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) ((GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsType GhcPs -> Printer ()
GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
putType [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxs)
        [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxs ->
          Printer () -> Printer ()
forall a. P a -> P a
parenthesize (Printer () -> Printer ()) -> Printer () -> Printer ()
forall a b. (a -> b) -> a -> b
$ Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep (Printer ()
comma 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) ((GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsType GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LHsType GhcPs -> Printer ()
GenLocated SrcSpanAnnA (HsType GhcPs) -> Printer ()
putType [GenLocated SrcSpanAnnA (HsType GhcPs)]
ctxs)
  where
    ltys :: [LHsType GhcPs]
ltys = GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
-> [GenLocated SrcSpanAnnA (HsType GhcPs)]
forall l e. GenLocated l e -> e
GHC.unLoc LHsContext GhcPs
GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcPs)]
lctx :: [GHC.LHsType GHC.GhcPs]

putConDeclField :: Config -> GHC.ConDeclField GHC.GhcPs -> P ()
putConDeclField :: Config -> ConDeclField GhcPs -> Printer ()
putConDeclField Config
cfg GHC.ConDeclField {[LFieldOcc GhcPs]
Maybe (LHsDoc GhcPs)
XConDeclField GhcPs
LHsType GhcPs
cd_fld_ext :: XConDeclField GhcPs
cd_fld_names :: [LFieldOcc GhcPs]
cd_fld_type :: LHsType GhcPs
cd_fld_doc :: Maybe (LHsDoc GhcPs)
cd_fld_ext :: forall pass. ConDeclField pass -> XConDeclField pass
cd_fld_names :: forall pass. ConDeclField pass -> [LFieldOcc pass]
cd_fld_type :: forall pass. ConDeclField pass -> LBangType pass
cd_fld_doc :: forall pass. ConDeclField pass -> Maybe (LHsDoc pass)
..} = do
    Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep
        (Printer ()
comma 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)
        ((GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> Printer ())
-> [GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)] -> [Printer ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable [LFieldOcc GhcPs]
[GenLocated (SrcAnn NoEpAnns) (FieldOcc GhcPs)]
cd_fld_names)
    Printer ()
space
    [Char] -> Printer ()
putText [Char]
"::"
    Printer ()
space
    Config -> LHsType GhcPs -> Printer ()
putType' Config
cfg LHsType GhcPs
cd_fld_type

-- | A variant of 'putType' that takes 'cCurriedContext' into account
putType' :: Config -> GHC.LHsType GHC.GhcPs -> P ()
putType' :: Config -> LHsType GhcPs -> Printer ()
putType' Config
cfg LHsType GhcPs
lty = case GenLocated SrcSpanAnnA (HsType GhcPs) -> HsType GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc LHsType GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
lty of
    GHC.HsForAllTy XForAllTy GhcPs
NoExtField
GHC.NoExtField HsForAllTelescope GhcPs
tele LHsType GhcPs
tp -> do
        [Char] -> Printer ()
putText [Char]
"forall"
        Printer ()
space
        Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep Printer ()
space ([Printer ()] -> Printer ()) -> [Printer ()] -> Printer ()
forall a b. (a -> b) -> a -> b
$ case HsForAllTelescope GhcPs
tele of
            GHC.HsForAllVis   {[LHsTyVarBndr () GhcPs]
XHsForAllVis GhcPs
hsf_xvis :: XHsForAllVis GhcPs
hsf_vis_bndrs :: [LHsTyVarBndr () GhcPs]
hsf_xvis :: forall pass. HsForAllTelescope pass -> XHsForAllVis pass
hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
..} -> HsTyVarBndr () GhcPs -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable (HsTyVarBndr () GhcPs -> Printer ())
-> (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
    -> HsTyVarBndr () GhcPs)
-> GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)
-> HsTyVarBndr () GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc (GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs) -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsTyVarBndr () GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr () GhcPs)]
hsf_vis_bndrs
            GHC.HsForAllInvis {[LHsTyVarBndr Specificity GhcPs]
XHsForAllInvis GhcPs
hsf_xinvis :: XHsForAllInvis GhcPs
hsf_invis_bndrs :: [LHsTyVarBndr Specificity GhcPs]
hsf_xinvis :: forall pass. HsForAllTelescope pass -> XHsForAllInvis pass
hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
..} -> HsTyVarBndr Specificity GhcPs -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable (HsTyVarBndr Specificity GhcPs -> Printer ())
-> (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
    -> HsTyVarBndr Specificity GhcPs)
-> GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
-> HsTyVarBndr Specificity GhcPs
forall l e. GenLocated l e -> e
GHC.unLoc (GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)
 -> Printer ())
-> [GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
-> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsTyVarBndr Specificity GhcPs]
[GenLocated SrcSpanAnnA (HsTyVarBndr Specificity GhcPs)]
hsf_invis_bndrs
        case HsForAllTelescope GhcPs
tele of
            GHC.HsForAllVis   {} -> Printer ()
space Printer () -> Printer () -> Printer ()
forall a b. Printer a -> Printer b -> Printer b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Printer ()
putText [Char]
"->"
            GHC.HsForAllInvis {} -> [Char] -> Printer ()
putText [Char]
"."
        Printer ()
space
        Config -> LHsType GhcPs -> Printer ()
putType' Config
cfg LHsType GhcPs
tp
    GHC.HsQualTy XQualTy GhcPs
NoExtField
GHC.NoExtField LHsContext GhcPs
ctx LHsType GhcPs
tp -> do
        Config -> LHsContext GhcPs -> Printer ()
putContext Config
cfg LHsContext GhcPs
ctx
        Config -> LHsType GhcPs -> Printer ()
putType' Config
cfg LHsType GhcPs
tp
    HsType GhcPs
_ -> LHsType GhcPs -> Printer ()
putType LHsType GhcPs
lty

newOrData :: DataDecl -> String
newOrData :: DataDecl -> [Char]
newOrData DataDecl
decl = if DataDecl -> Bool
isNewtype DataDecl
decl then [Char]
"newtype" else [Char]
"data"

isGADT :: DataDecl -> Bool
isGADT :: DataDecl -> Bool
isGADT = (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Bool)
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Bool
forall {l} {pass}. GenLocated l (ConDecl pass) -> Bool
isGADTCons (DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool)
-> (DataDecl
    -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> DataDecl
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
HsDataDefn GhcPs
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
GHC.dd_cons (HsDataDefn GhcPs
 -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> (DataDecl -> HsDataDefn GhcPs)
-> DataDecl
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDecl -> HsDataDefn GhcPs
dataDefn
  where
    isGADTCons :: GenLocated l (ConDecl pass) -> Bool
isGADTCons GenLocated l (ConDecl pass)
c = case GenLocated l (ConDecl pass) -> ConDecl pass
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated l (ConDecl pass)
c of
      GHC.ConDeclGADT {} -> Bool
True
      ConDecl pass
_                  -> Bool
False

isNewtype :: DataDecl -> Bool
isNewtype :: DataDecl -> Bool
isNewtype = (NewOrData -> NewOrData -> Bool
forall a. Eq a => a -> a -> Bool
== NewOrData
GHC.NewType) (NewOrData -> Bool) -> (DataDecl -> NewOrData) -> DataDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> NewOrData
forall a. DataDefnCons a -> NewOrData
GHC.dataDefnConsNewOrData (DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
 -> NewOrData)
-> (DataDecl
    -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> DataDecl
-> NewOrData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
HsDataDefn GhcPs
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
GHC.dd_cons (HsDataDefn GhcPs
 -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> (DataDecl -> HsDataDefn GhcPs)
-> DataDecl
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDecl -> HsDataDefn GhcPs
dataDefn

isInfix :: DataDecl -> Bool
isInfix :: DataDecl -> Bool
isInfix = (LexicalFixity -> LexicalFixity -> Bool
forall a. Eq a => a -> a -> Bool
== LexicalFixity
GHC.Infix) (LexicalFixity -> Bool)
-> (DataDecl -> LexicalFixity) -> DataDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDecl -> LexicalFixity
dataFixity

isEnum :: DataDecl -> Bool
isEnum :: DataDecl -> Bool
isEnum = (GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Bool)
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GenLocated SrcSpanAnnA (ConDecl GhcPs) -> Bool
forall {l} {pass}. GenLocated l (ConDecl pass) -> Bool
isUnary (DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool)
-> (DataDecl
    -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> DataDecl
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
HsDataDefn GhcPs
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
GHC.dd_cons (HsDataDefn GhcPs
 -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> (DataDecl -> HsDataDefn GhcPs)
-> DataDecl
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDecl -> HsDataDefn GhcPs
dataDefn
  where
    isUnary :: GenLocated l (ConDecl pass) -> Bool
isUnary GenLocated l (ConDecl pass)
c = case GenLocated l (ConDecl pass) -> ConDecl pass
forall l e. GenLocated l e -> e
GHC.unLoc GenLocated l (ConDecl pass)
c of
      GHC.ConDeclH98 {Bool
[LHsTyVarBndr Specificity pass]
Maybe (LHsContext pass)
Maybe (LHsDoc pass)
XConDeclH98 pass
LIdP pass
HsConDeclH98Details pass
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> LIdP pass
con_forall :: forall pass. ConDecl pass -> Bool
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_ext :: XConDeclH98 pass
con_name :: LIdP pass
con_forall :: Bool
con_ex_tvs :: [LHsTyVarBndr Specificity pass]
con_mb_cxt :: Maybe (LHsContext pass)
con_args :: HsConDeclH98Details pass
con_doc :: Maybe (LHsDoc pass)
..} -> case HsConDeclH98Details pass
con_args of
        GHC.PrefixCon [Void]
tyargs [HsScaled pass (LBangType pass)]
args -> [Void] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Void]
tyargs Bool -> Bool -> Bool
&& [HsScaled pass (LBangType pass)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HsScaled pass (LBangType pass)]
args
        HsConDeclH98Details pass
_                         -> Bool
False
      ConDecl pass
_ -> Bool
False

hasConstructors :: DataDecl -> Bool
hasConstructors :: DataDecl -> Bool
hasConstructors = Bool -> Bool
not (Bool -> Bool) -> (DataDecl -> Bool) -> DataDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool
forall a. DataDefnCons a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Bool)
-> (DataDecl
    -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> DataDecl
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
HsDataDefn GhcPs
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
GHC.dd_cons (HsDataDefn GhcPs
 -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> (DataDecl -> HsDataDefn GhcPs)
-> DataDecl
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDecl -> HsDataDefn GhcPs
dataDefn

singleConstructor :: DataDecl -> Bool
singleConstructor :: DataDecl -> Bool
singleConstructor = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1) (Int -> Bool) -> (DataDecl -> Int) -> DataDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Int
forall a. DataDefnCons a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)) -> Int)
-> (DataDecl
    -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> DataDecl
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
HsDataDefn GhcPs
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
GHC.dd_cons (HsDataDefn GhcPs
 -> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs)))
-> (DataDecl -> HsDataDefn GhcPs)
-> DataDecl
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDecl -> HsDataDefn GhcPs
dataDefn

hasDeriving :: DataDecl -> Bool
hasDeriving :: DataDecl -> Bool
hasDeriving = Bool -> Bool
not (Bool -> Bool) -> (DataDecl -> Bool) -> DataDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)] -> Bool)
-> (DataDecl
    -> [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)])
-> DataDecl
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> HsDeriving GhcPs
HsDataDefn GhcPs
-> [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
forall pass. HsDataDefn pass -> HsDeriving pass
GHC.dd_derivs (HsDataDefn GhcPs
 -> [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)])
-> (DataDecl -> HsDataDefn GhcPs)
-> DataDecl
-> [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDecl -> HsDataDefn GhcPs
dataDefn