{-# 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]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Indent] -> ShowS
$cshowList :: [Indent] -> ShowS
show :: Indent -> [Char]
$cshow :: Indent -> [Char]
showsPrec :: Int -> Indent -> ShowS
$cshowsPrec :: Int -> Indent -> ShowS
Show, Indent -> Indent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Indent -> Indent -> Bool
$c/= :: Indent -> Indent -> Bool
== :: Indent -> Indent -> Bool
$c== :: Indent -> Indent -> Bool
Eq)

data MaxColumns
  = MaxColumns !Int
  | NoMaxColumns
  deriving (Int -> MaxColumns -> ShowS
[MaxColumns] -> ShowS
MaxColumns -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MaxColumns] -> ShowS
$cshowList :: [MaxColumns] -> ShowS
show :: MaxColumns -> [Char]
$cshow :: MaxColumns -> [Char]
showsPrec :: Int -> MaxColumns -> ShowS
$cshowsPrec :: Int -> MaxColumns -> ShowS
Show, MaxColumns -> MaxColumns -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxColumns -> MaxColumns -> Bool
$c/= :: MaxColumns -> MaxColumns -> Bool
== :: MaxColumns -> MaxColumns -> Bool
$c== :: 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]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> [Char]
$cshow :: Config -> [Char]
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> 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 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Config -> DataDecl -> Edits
formatDataDecl Config
cfg) 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 <- forall p. HsModule p -> [LHsDecl p]
GHC.hsmodDecls forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
GHC.unLoc Module
m
        GHC.TyClD XTyClD GhcPs
_ TyClDecl GhcPs
tycld <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
GHC.unLoc GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl
        RealSrcSpan
loc <- forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan forall a b. (a -> b) -> a -> b
$ forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
GHC.getLocA GenLocated SrcSpanAnnA (HsDecl GhcPs)
ldecl
        case TyClDecl GhcPs
tycld of
            GHC.DataDecl {HsDataDefn GhcPs
LHsQTyVars GhcPs
LexicalFixity
LIdP GhcPs
XDataDecl 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
tcdDataDefn :: HsDataDefn GhcPs
tcdFixity :: LexicalFixity
tcdTyVars :: LHsQTyVars GhcPs
tcdLName :: LIdP GhcPs
tcdDExt :: XDataDecl GhcPs
..} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ MkDataDecl
                { dataComments :: [LEpaComment]
dataComments = forall a. EpAnn a -> [LEpaComment]
epAnnComments XDataDecl GhcPs
tcdDExt
                , dataLoc :: RealSrcSpan
dataLoc      = RealSrcSpan
loc
                , dataDeclName :: GenLocated SrcSpanAnnN RdrName
dataDeclName = LIdP GhcPs
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
cMaxColumns :: MaxColumns
cSortDeriving :: Bool
cCurriedContext :: Bool
cVia :: Indent
cBreakSingleConstructors :: Bool
cBreakEnums :: Bool
cDeriving :: Int
cFieldComment :: Int
cFirstField :: Indent
cEquals :: Indent
cMaxColumns :: Config -> MaxColumns
cSortDeriving :: Config -> Bool
cCurriedContext :: Config -> Bool
cVia :: Config -> Indent
cBreakSingleConstructors :: Config -> Bool
cBreakEnums :: Config -> Bool
cDeriving :: Config -> Int
cFieldComment :: Config -> Int
cFirstField :: Config -> Indent
cEquals :: Config -> Indent
..} decl :: DataDecl
decl@MkDataDecl {[LEpaComment]
HsDataDefn GhcPs
LHsQTyVars GhcPs
LexicalFixity
RealSrcSpan
GenLocated SrcSpanAnnN RdrName
dataFixity :: LexicalFixity
dataDefn :: HsDataDefn GhcPs
dataTypeVars :: LHsQTyVars GhcPs
dataDeclName :: GenLocated SrcSpanAnnN RdrName
dataLoc :: RealSrcSpan
dataComments :: [LEpaComment]
dataFixity :: DataDecl -> LexicalFixity
dataDefn :: DataDecl -> HsDataDefn GhcPs
dataTypeVars :: DataDecl -> LHsQTyVars GhcPs
dataDeclName :: DataDecl -> GenLocated SrcSpanAnnN RdrName
dataLoc :: DataDecl -> RealSrcSpan
dataComments :: DataDecl -> [LEpaComment]
..} =
    Block [Char] -> (Lines -> Lines) -> Edits
Editor.changeLines forall {a}. Block a
originalDeclBlock (forall a b. a -> b -> a
const Lines
printedDecl)
  where
    originalDeclBlock :: Block a
originalDeclBlock = 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 -> forall a. Maybe a
Nothing
            MaxColumns Int
n -> forall a. a -> Maybe a
Just Int
n
        }

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

putDataDecl :: Config -> DataDecl -> P ()
putDataDecl :: Config -> DataDecl -> P ()
putDataDecl cfg :: Config
cfg@Config {Bool
Int
MaxColumns
Indent
cMaxColumns :: MaxColumns
cSortDeriving :: Bool
cCurriedContext :: Bool
cVia :: Indent
cBreakSingleConstructors :: Bool
cBreakEnums :: Bool
cDeriving :: Int
cFieldComment :: Int
cFirstField :: Indent
cEquals :: Indent
cMaxColumns :: Config -> MaxColumns
cSortDeriving :: Config -> Bool
cCurriedContext :: Config -> Bool
cVia :: Config -> Indent
cBreakSingleConstructors :: Config -> Bool
cBreakEnums :: Config -> Bool
cDeriving :: Config -> Int
cFieldComment :: Config -> Int
cFirstField :: Config -> Indent
cEquals :: Config -> Indent
..} DataDecl
decl = do
    let defn :: HsDataDefn GhcPs
defn = DataDecl -> HsDataDefn GhcPs
dataDefn DataDecl
decl
        constructorComments :: [CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs))]
constructorComments = forall a.
(a -> Maybe RealSrcSpan)
-> [a] -> [LEpaComment] -> [CommentGroup a]
commentGroups
            (SrcSpan -> Maybe RealSrcSpan
GHC.srcSpanToRealSrcSpan forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
&&
            forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CommentGroup a -> Bool
commentGroupHasComments) [CommentGroup (GenLocated SrcSpanAnnA (ConDecl GhcPs))]
constructorComments

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

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

    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 -> P ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> P ()
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 ->
                    P ()
space
            (Indent Int
x, Indent
_)
                | Bool
onelineEnum -> P ()
space
                | Bool
otherwise -> P ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> P ()
spaces Int
x
            (Indent
SameLine, Indent
_) -> P ()
space

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

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

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

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

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

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

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

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

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

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

    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 forall a b. (a -> b) -> a -> b
$ \GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
lstrat -> case forall l e. GenLocated l e -> e
GHC.unLoc GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
lstrat of
        GHC.StockStrategy    {} -> P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
"stock"
        GHC.AnyclassStrategy {} -> P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
"anyclass"
        GHC.NewtypeStrategy  {} -> P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
"newtype"
        GHC.ViaStrategy      {} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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

            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 ->
                P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Outputable a => a -> P ()
putOutputable GenLocated SrcSpanAnnA (HsType GhcPs)
t

            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
                P ()
newline
                Int -> P ()
spaces Int
indentation
                P ()
comma
                P ()
space
                forall a. Outputable a => a -> P ()
putOutputable GenLocated SrcSpanAnnA (HsType GhcPs)
t

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

    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 forall a b. (a -> b) -> a -> b
$ \GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcPs)
lstrat -> case 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 -> P ()
space
                Indent Int
x -> P ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> P ()
spaces (Int
x forall a. Num a => a -> a -> a
+ Int
cDeriving)

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

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

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

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

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

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

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

    maybeKindSig :: Maybe (GHC.LHsKind GHC.GhcPs)
    maybeKindSig :: Maybe (LHsType GhcPs)
maybeKindSig = 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 -> P ()
putConstructor Config
cfg Int
consIndent LConDecl GhcPs
lcons = case forall l e. GenLocated l e -> e
GHC.unLoc LConDecl GhcPs
lcons of
  GHC.ConDeclGADT {Maybe (LHsDoc GhcPs)
Maybe (LHsContext GhcPs)
NonEmpty (LIdP GhcPs)
HsConDeclGADTDetails GhcPs
XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
LHsType GhcPs
LHsUniToken "::" "\8759" GhcPs
XConDeclGADT 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)
con_doc :: Maybe (LHsDoc GhcPs)
con_res_ty :: LHsType GhcPs
con_g_args :: HsConDeclGADTDetails GhcPs
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_bndrs :: XRec GhcPs (HsOuterSigTyVarBndrs GhcPs)
con_dcolon :: LHsUniToken "::" "\8759" GhcPs
con_names :: NonEmpty (LIdP GhcPs)
con_g_ext :: XConDeclGADT GhcPs
..} -> do
    -- Put argument to constructor first:
    case HsConDeclGADTDetails GhcPs
con_g_args of
      GHC.PrefixConGADT [HsScaled GhcPs (LHsType GhcPs)]
_ -> forall a. P a -> [P a] -> P ()
sep (P ()
comma forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenLocated SrcSpanAnnN RdrName -> P ()
putRdrName forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (LIdP GhcPs)
con_names
      GHC.RecConGADT XRec GhcPs [LConDeclField GhcPs]
_ LHsUniToken "->" "\8594" GhcPs
_ -> forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat 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:
    P ()
space
    [Char] -> P ()
putText [Char]
"::"
    P ()
space

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

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

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

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

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

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

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

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

    where
      -- Jump to the first brace of the first record of the first constructor.
      skipToBrace :: P ()
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) -> P ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> P ()
spaces Int
y
        (Indent
SameLine, Indent
SameLine) -> P ()
space
        (Indent Int
x, Indent Int
y) -> P ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> P ()
spaces (Int
x forall a. Num a => a -> a -> a
+ Int
y forall a. Num a => a -> a -> a
+ Int
2)
        (Indent
SameLine, Indent Int
y) -> P ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> P ()
spaces (Int
consIndent forall a. Num a => a -> a -> a
+ Int
y)
        (Indent Int
_, Indent
SameLine) -> P ()
space

      -- Jump to the next declaration.
      sepDecl :: Int -> P ()
sepDecl Int
bracePos = P ()
newline forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> P ()
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 forall a. Num a => a -> a -> a
+ Int
y forall a. Num a => a -> a -> a
+ Int
2
        (Indent
SameLine, Indent Int
y)                               -> Int
bracePos forall a. Num a => a -> a -> a
+ Int
y forall a. Num a => a -> a -> a
- Int
2
        (Indent Int
x, Indent
SameLine)                               -> Int
bracePos forall a. Num a => a -> a -> a
+ Int
x forall a. Num a => a -> a -> a
- Int
2

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

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

putConDeclField :: Config -> GHC.ConDeclField GHC.GhcPs -> P ()
putConDeclField :: Config -> ConDeclField GhcPs -> P ()
putConDeclField Config
cfg GHC.ConDeclField {[LFieldOcc GhcPs]
Maybe (LHsDoc GhcPs)
LHsType GhcPs
XConDeclField 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)
cd_fld_doc :: Maybe (LHsDoc GhcPs)
cd_fld_type :: LHsType GhcPs
cd_fld_names :: [LFieldOcc GhcPs]
cd_fld_ext :: XConDeclField GhcPs
..} = do
    forall a. P a -> [P a] -> P ()
sep
        (P ()
comma forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P ()
space)
        (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Outputable a => a -> P ()
putOutputable [LFieldOcc GhcPs]
cd_fld_names)
    P ()
space
    [Char] -> P ()
putText [Char]
"::"
    P ()
space
    Config -> LHsType GhcPs -> P ()
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 -> P ()
putType' Config
cfg LHsType GhcPs
lty = case forall l e. GenLocated l e -> e
GHC.unLoc LHsType GhcPs
lty of
    GHC.HsForAllTy NoExtField
XForAllTy GhcPs
GHC.NoExtField HsForAllTelescope GhcPs
tele LHsType GhcPs
tp -> do
        [Char] -> P ()
putText [Char]
"forall"
        P ()
space
        forall a. P a -> [P a] -> P ()
sep P ()
space forall a b. (a -> b) -> a -> b
$ case HsForAllTelescope GhcPs
tele of
            GHC.HsForAllVis   {[LHsTyVarBndr () GhcPs]
XHsForAllVis GhcPs
hsf_xvis :: forall pass. HsForAllTelescope pass -> XHsForAllVis pass
hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs :: [LHsTyVarBndr () GhcPs]
hsf_xvis :: XHsForAllVis GhcPs
..} -> forall a. Outputable a => a -> P ()
putOutputable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
GHC.unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsTyVarBndr () GhcPs]
hsf_vis_bndrs
            GHC.HsForAllInvis {[LHsTyVarBndr Specificity GhcPs]
XHsForAllInvis GhcPs
hsf_xinvis :: forall pass. HsForAllTelescope pass -> XHsForAllInvis pass
hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs :: [LHsTyVarBndr Specificity GhcPs]
hsf_xinvis :: XHsForAllInvis GhcPs
..} -> forall a. Outputable a => a -> P ()
putOutputable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
GHC.unLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LHsTyVarBndr Specificity GhcPs]
hsf_invis_bndrs
        case HsForAllTelescope GhcPs
tele of
            GHC.HsForAllVis   {} -> P ()
space forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> P ()
putText [Char]
"->"
            GHC.HsForAllInvis {} -> [Char] -> P ()
putText [Char]
"."
        P ()
space
        Config -> LHsType GhcPs -> P ()
putType' Config
cfg LHsType GhcPs
tp
    GHC.HsQualTy NoExtField
XQualTy GhcPs
GHC.NoExtField LHsContext GhcPs
ctx LHsType GhcPs
tp -> do
        Config -> LHsContext GhcPs -> P ()
putContext Config
cfg LHsContext GhcPs
ctx
        Config -> LHsType GhcPs -> P ()
putType' Config
cfg LHsType GhcPs
tp
    HsType GhcPs
_ -> LHsType GhcPs -> P ()
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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall {l} {pass}. GenLocated l (ConDecl pass) -> Bool
isGADTCons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
GHC.dd_cons 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 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 = (forall a. Eq a => a -> a -> Bool
== NewOrData
GHC.NewType) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DataDefnCons a -> NewOrData
GHC.dataDefnConsNewOrData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
GHC.dd_cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDecl -> HsDataDefn GhcPs
dataDefn

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

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

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

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