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

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

--------------------------------------------------------------------------------
import           Prelude                          hiding (init)

--------------------------------------------------------------------------------
import           Control.Monad                    (forM_, unless, when)
import           Data.Function                    ((&))
import           Data.Functor                     ((<&>))
import           Data.List                        (sortBy)
import           Data.Maybe                       (listToMaybe)

--------------------------------------------------------------------------------
import           ApiAnnotation                    (AnnotationComment)
import           BasicTypes                       (LexicalFixity (..))
import           GHC.Hs.Decls                     (ConDecl (..),
                                                   DerivStrategy (..),
                                                   HsDataDefn (..), HsDecl (..),
                                                   HsDerivingClause (..),
                                                   NewOrData (..),
                                                   TyClDecl (..))
import           GHC.Hs.Extension                 (GhcPs, NoExtField (..),
                                                   noExtCon)
import           GHC.Hs.Types                     (ConDeclField (..),
                                                   ForallVisFlag (..),
                                                   HsConDetails (..), HsContext,
                                                   HsImplicitBndrs (..),
                                                   HsTyVarBndr (..),
                                                   HsType (..), LHsQTyVars (..))
import           RdrName                          (RdrName)
import           SrcLoc                           (GenLocated (..), Located,
                                                   RealLocated)

--------------------------------------------------------------------------------
import           Language.Haskell.Stylish.Block
import           Language.Haskell.Stylish.Editor
import           Language.Haskell.Stylish.GHC
import           Language.Haskell.Stylish.Module
import           Language.Haskell.Stylish.Printer
import           Language.Haskell.Stylish.Step

data Indent
    = SameLine
    | Indent !Int
  deriving (Int -> Indent -> ShowS
[Indent] -> ShowS
Indent -> String
(Int -> Indent -> ShowS)
-> (Indent -> String) -> ([Indent] -> ShowS) -> Show Indent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Indent] -> ShowS
$cshowList :: [Indent] -> ShowS
show :: Indent -> String
$cshow :: Indent -> String
showsPrec :: Int -> Indent -> ShowS
$cshowsPrec :: Int -> Indent -> ShowS
Show, Indent -> Indent -> Bool
(Indent -> Indent -> Bool)
-> (Indent -> Indent -> Bool) -> Eq Indent
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 -> String
(Int -> MaxColumns -> ShowS)
-> (MaxColumns -> String)
-> ([MaxColumns] -> ShowS)
-> Show MaxColumns
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxColumns] -> ShowS
$cshowList :: [MaxColumns] -> ShowS
show :: MaxColumns -> String
$cshow :: MaxColumns -> String
showsPrec :: Int -> MaxColumns -> ShowS
$cshowsPrec :: Int -> MaxColumns -> ShowS
Show, MaxColumns -> MaxColumns -> Bool
(MaxColumns -> MaxColumns -> Bool)
-> (MaxColumns -> MaxColumns -> Bool) -> Eq MaxColumns
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 -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)

-- | TODO: pass in MaxColumns?
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Indent
-> Indent
-> Int
-> Int
-> Bool
-> Bool
-> Indent
-> Bool
-> Bool
-> MaxColumns
-> Config
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 = String -> (Lines -> Module -> Lines) -> Step
makeStep String
"Data" \Lines
ls Module
m -> [Change String] -> Lines -> Lines
forall a. [Change a] -> [a] -> [a]
applyChanges (Module -> [Change String]
changes Module
m) Lines
ls
  where
    changes :: Module -> [ChangeLine]
    changes :: Module -> [Change String]
changes Module
m = (Located DataDecl -> Change String)
-> [Located DataDecl] -> [Change String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Config -> Module -> Located DataDecl -> Change String
formatDataDecl Config
cfg Module
m) (Module -> [Located DataDecl]
dataDecls Module
m)

    dataDecls :: Module -> [Located DataDecl]
    dataDecls :: Module -> [Located DataDecl]
dataDecls = (GenLocated SrcSpan (HsDecl GhcPs) -> [Located DataDecl])
-> Module -> [Located DataDecl]
forall a b. Typeable a => (a -> [b]) -> Module -> [b]
queryModule \case
      L SrcSpan
pos (TyClD XTyClD GhcPs
_ (DataDecl XDataDecl GhcPs
_ Located (IdP GhcPs)
name LHsQTyVars GhcPs
tvars LexicalFixity
fixity HsDataDefn GhcPs
defn)) -> Located DataDecl -> [Located DataDecl]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Located DataDecl -> [Located DataDecl])
-> (DataDecl -> Located DataDecl) -> DataDecl -> [Located DataDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> DataDecl -> Located DataDecl
forall l e. l -> e -> GenLocated l e
L SrcSpan
pos (DataDecl -> [Located DataDecl]) -> DataDecl -> [Located DataDecl]
forall a b. (a -> b) -> a -> b
$ MkDataDecl :: Located RdrName
-> LHsQTyVars GhcPs
-> HsDataDefn GhcPs
-> LexicalFixity
-> DataDecl
MkDataDecl
        { dataDeclName :: Located RdrName
dataDeclName = Located (IdP GhcPs)
Located RdrName
name
        , dataTypeVars :: LHsQTyVars GhcPs
dataTypeVars = LHsQTyVars GhcPs
tvars
        , dataDefn :: HsDataDefn GhcPs
dataDefn = HsDataDefn GhcPs
defn
        , dataFixity :: LexicalFixity
dataFixity = LexicalFixity
fixity
        }
      GenLocated SrcSpan (HsDecl GhcPs)
_ -> []

type ChangeLine = Change String

formatDataDecl :: Config -> Module -> Located DataDecl -> ChangeLine
formatDataDecl :: Config -> Module -> Located DataDecl -> Change String
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
..} Module
m ldecl :: Located DataDecl
ldecl@(L SrcSpan
declPos DataDecl
decl) =
  Block String -> (Lines -> Lines) -> Change String
forall a. Block a -> ([a] -> [a]) -> Change a
change Block String
forall a. Block a
originalDeclBlock (Lines -> Lines -> Lines
forall a b. a -> b -> a
const Lines
printedDecl)
  where
    relevantComments :: [RealLocated AnnotationComment]
    relevantComments :: [RealLocated AnnotationComment]
relevantComments
      = Module -> Comments
moduleComments Module
m
      Comments
-> (Comments -> [RealLocated AnnotationComment])
-> [RealLocated AnnotationComment]
forall a b. a -> (a -> b) -> b
& Comments -> [RealLocated AnnotationComment]
rawComments
      [RealLocated AnnotationComment]
-> ([RealLocated AnnotationComment]
    -> [RealLocated AnnotationComment])
-> [RealLocated AnnotationComment]
forall a b. a -> (a -> b) -> b
& Located DataDecl
-> [RealLocated AnnotationComment]
-> [RealLocated AnnotationComment]
forall a b. Located a -> [RealLocated b] -> [RealLocated b]
dropBeforeAndAfter Located DataDecl
ldecl

    defn :: HsDataDefn GhcPs
defn = DataDecl -> HsDataDefn GhcPs
dataDefn DataDecl
decl

    originalDeclBlock :: Block a
originalDeclBlock =
      Int -> Int -> Block a
forall a. Int -> Int -> Block a
Block (Located DataDecl -> Int
forall a. Located a -> Int
getStartLineUnsafe Located DataDecl
ldecl) (Located DataDecl -> Int
forall a. Located a -> Int
getEndLineUnsafe Located DataDecl
ldecl)

    printerConfig :: PrinterConfig
printerConfig = PrinterConfig :: Maybe Int -> 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
-> [RealLocated AnnotationComment] -> Module -> Printer () -> Lines
forall a.
PrinterConfig
-> [RealLocated AnnotationComment] -> Module -> Printer a -> Lines
runPrinter_ PrinterConfig
printerConfig [RealLocated AnnotationComment]
relevantComments Module
m do
      String -> Printer ()
putText (DataDecl -> String
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"where")

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

        Int
lineLengthAfterEq <- (Int -> Int) -> Printer Int -> Printer Int
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 DataDecl -> Bool
isEnum DataDecl
decl Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
cBreakEnums then
          String -> Printer ()
putText String
"=" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Config -> DataDecl -> Printer ()
putUnbrokenEnum Config
cfg DataDecl
decl
        else if DataDecl -> Bool
isNewtype DataDecl
decl then
          String -> Printer ()
putText String
"=" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [LConDecl GhcPs] -> (LConDecl GhcPs -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HsDataDefn GhcPs -> [LConDecl GhcPs]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn GhcPs
defn) (Config -> LConDecl GhcPs -> Printer ()
putNewtypeConstructor Config
cfg)
        else
          case HsDataDefn GhcPs -> [LConDecl GhcPs]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn GhcPs
defn of
            [] -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            lcon :: LConDecl GhcPs
lcon@(L SrcSpan
pos ConDecl GhcPs
_) : [LConDecl GhcPs]
consRest -> do
              Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
breakLineBeforeEq do
                SrcSpan -> P [AnnotationComment]
removeCommentTo SrcSpan
pos P [AnnotationComment]
-> ([AnnotationComment] -> Printer ()) -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AnnotationComment -> Printer ())
-> [AnnotationComment] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \AnnotationComment
c -> AnnotationComment -> Printer ()
putComment AnnotationComment
c Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
consIndent Int
lineLengthAfterEq

              Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
                (DataDecl -> Bool
isGADT DataDecl
decl)
                (String -> Printer ()
putText String
"=" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space)

              Config -> Int -> LConDecl GhcPs -> Printer ()
putConstructor Config
cfg Int
lineLengthAfterEq LConDecl GhcPs
lcon
              [LConDecl GhcPs] -> (LConDecl GhcPs -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LConDecl GhcPs]
consRest \con :: LConDecl GhcPs
con@(L SrcSpan
conPos ConDecl GhcPs
_) -> do
                Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Indent
cFirstField Indent -> Indent -> Bool
forall a. Eq a => a -> a -> Bool
== Indent
SameLine) do
                  SrcSpan -> P [AnnotationComment]
removeCommentTo SrcSpan
conPos P [AnnotationComment]
-> ([AnnotationComment] -> Printer ()) -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AnnotationComment -> Printer ())
-> [AnnotationComment] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \AnnotationComment
c -> Int -> Printer ()
consIndent Int
lineLengthAfterEq Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnotationComment -> Printer ()
putComment AnnotationComment
c
                Int -> Printer ()
consIndent Int
lineLengthAfterEq

                Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
                  (DataDecl -> Bool
isGADT DataDecl
decl)
                  (String -> Printer ()
putText String
"|" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space)

                Config -> Int -> LConDecl GhcPs -> Printer ()
putConstructor Config
cfg Int
lineLengthAfterEq LConDecl GhcPs
con
                SrcSpan -> Printer ()
putEolComment SrcSpan
conPos

        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (DataDecl -> Bool
hasDeriving DataDecl
decl) do
          if DataDecl -> Bool
isEnum DataDecl
decl Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
cBreakEnums then
            Printer ()
space
          else do
            SrcSpan -> P [AnnotationComment]
removeCommentTo (HsDataDefn GhcPs
defn HsDataDefn GhcPs
-> (HsDataDefn GhcPs -> HsDeriving GhcPs) -> HsDeriving GhcPs
forall a b. a -> (a -> b) -> b
& HsDataDefn GhcPs -> HsDeriving GhcPs
forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs HsDeriving GhcPs -> (HsDeriving GhcPs -> SrcSpan) -> SrcSpan
forall a b. a -> (a -> b) -> b
& \(L SrcSpan
pos [LHsDerivingClause GhcPs]
_) -> SrcSpan
pos) P [AnnotationComment]
-> ([AnnotationComment] -> Printer ()) -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
              (AnnotationComment -> Printer ())
-> [AnnotationComment] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \AnnotationComment
c -> Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
spaces Int
cDeriving Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnotationComment -> Printer ()
putComment AnnotationComment
c
            Printer ()
newline
            Int -> Printer ()
spaces Int
cDeriving

        Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep (Printer ()
newline Printer () -> Printer () -> Printer ()
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
$ HsDataDefn GhcPs
defn HsDataDefn GhcPs
-> (HsDataDefn GhcPs -> HsDeriving GhcPs) -> HsDeriving GhcPs
forall a b. a -> (a -> b) -> b
& HsDataDefn GhcPs -> HsDeriving GhcPs
forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs HsDeriving GhcPs
-> (HsDeriving GhcPs -> [Printer ()]) -> [Printer ()]
forall a b. a -> (a -> b) -> b
& \(L SrcSpan
pos [LHsDerivingClause GhcPs]
ds) -> [LHsDerivingClause GhcPs]
ds [LHsDerivingClause GhcPs]
-> (LHsDerivingClause GhcPs -> Printer ()) -> [Printer ()]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \LHsDerivingClause GhcPs
d -> do
          Printer () -> SrcSpan -> Printer ()
putAllSpanComments (Printer ()
newline Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
spaces Int
cDeriving) SrcSpan
pos
          Config -> LHsDerivingClause GhcPs -> Printer ()
putDeriving Config
cfg LHsDerivingClause GhcPs
d

    consIndent :: Int -> Printer ()
consIndent Int
eqIndent = Printer ()
newline Printer () -> Printer () -> Printer ()
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

data DataDecl = MkDataDecl
  { DataDecl -> Located RdrName
dataDeclName :: Located RdrName
  , DataDecl -> LHsQTyVars GhcPs
dataTypeVars :: LHsQTyVars GhcPs
  , DataDecl -> HsDataDefn GhcPs
dataDefn     :: HsDataDefn GhcPs
  , DataDecl -> LexicalFixity
dataFixity   :: LexicalFixity
  }

putDeriving :: Config -> Located (HsDerivingClause GhcPs) -> P ()
putDeriving :: Config -> LHsDerivingClause GhcPs -> Printer ()
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
..} (L SrcSpan
pos HsDerivingClause GhcPs
clause) = do
  String -> Printer ()
putText String
"deriving"

  Maybe (LDerivStrategy GhcPs)
-> (LDerivStrategy GhcPs -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HsDerivingClause GhcPs -> Maybe (LDerivStrategy GhcPs)
forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_strategy HsDerivingClause GhcPs
clause) \case
    L SrcSpan
_ DerivStrategy GhcPs
StockStrategy    -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"stock"
    L SrcSpan
_ DerivStrategy GhcPs
AnyclassStrategy -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"anyclass"
    L SrcSpan
_ DerivStrategy GhcPs
NewtypeStrategy  -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"newtype"
    L SrcSpan
_ (ViaStrategy XViaStrategy GhcPs
_)  -> () -> Printer ()
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
    Printer ()
oneLinePrint
    Printer ()
multilinePrint

  Maybe (LDerivStrategy GhcPs)
-> (LDerivStrategy GhcPs -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HsDerivingClause GhcPs -> Maybe (LDerivStrategy GhcPs)
forall pass. HsDerivingClause pass -> Maybe (LDerivStrategy pass)
deriv_clause_strategy HsDerivingClause GhcPs
clause) \case
    L SrcSpan
_ (ViaStrategy XViaStrategy GhcPs
tp) -> do
      case Indent
cVia of
        Indent
SameLine -> Printer ()
space
        Indent Int
x -> Printer ()
newline Printer () -> Printer () -> Printer ()
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)

      String -> Printer ()
putText String
"via"
      Printer ()
space
      Located (HsType GhcPs) -> Printer ()
putType (HsImplicitBndrs GhcPs (Located (HsType GhcPs))
-> Located (HsType GhcPs)
getType HsImplicitBndrs GhcPs (Located (HsType GhcPs))
XViaStrategy GhcPs
tp)
    LDerivStrategy GhcPs
_ -> () -> Printer ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  SrcSpan -> Printer ()
putEolComment SrcSpan
pos

  where
    getType :: HsImplicitBndrs GhcPs (Located (HsType GhcPs))
-> Located (HsType GhcPs)
getType = \case
      HsIB XHsIB GhcPs (Located (HsType GhcPs))
_ Located (HsType GhcPs)
tp          -> Located (HsType GhcPs)
tp
      XHsImplicitBndrs XXHsImplicitBndrs GhcPs (Located (HsType GhcPs))
x -> NoExtCon -> Located (HsType GhcPs)
forall a. NoExtCon -> a
noExtCon NoExtCon
XXHsImplicitBndrs GhcPs (Located (HsType GhcPs))
x

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

    oneLinePrint :: Printer ()
oneLinePrint = do
      Printer ()
space
      String -> Printer ()
putText String
"("
      Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep
        (Printer ()
comma Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space)
        ((Located (HsType GhcPs) -> Printer ())
-> [Located (HsType GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (HsType GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable [Located (HsType GhcPs)]
tys)
      String -> Printer ()
putText String
")"

    multilinePrint :: Printer ()
multilinePrint = do
      Printer ()
newline
      Int -> Printer ()
spaces Int
indentation
      String -> Printer ()
putText String
"("

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

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

      Printer ()
newline
      Int -> Printer ()
spaces Int
indentation
      String -> Printer ()
putText String
")"

    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

    tys :: [Located (HsType GhcPs)]
tys
      = HsDerivingClause GhcPs
clause
      HsDerivingClause GhcPs
-> (HsDerivingClause GhcPs
    -> Located [HsImplicitBndrs GhcPs (Located (HsType GhcPs))])
-> Located [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
forall a b. a -> (a -> b) -> b
& HsDerivingClause GhcPs
-> Located [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
forall pass. HsDerivingClause pass -> Located [LHsSigType pass]
deriv_clause_tys
      Located [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
-> (Located [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
    -> [HsImplicitBndrs GhcPs (Located (HsType GhcPs))])
-> [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
forall a b. a -> (a -> b) -> b
& Located [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
-> [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
forall a. Located a -> a
unLocated
      [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
-> ([HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
    -> [HsImplicitBndrs GhcPs (Located (HsType GhcPs))])
-> [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
forall a b. a -> (a -> b) -> b
& (if Bool
cSortDeriving then (HsImplicitBndrs GhcPs (Located (HsType GhcPs))
 -> HsImplicitBndrs GhcPs (Located (HsType GhcPs)) -> Ordering)
-> [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
-> [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy HsImplicitBndrs GhcPs (Located (HsType GhcPs))
-> HsImplicitBndrs GhcPs (Located (HsType GhcPs)) -> Ordering
forall a. Outputable a => a -> a -> Ordering
compareOutputable else [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
-> [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
forall a. a -> a
id)
      [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
-> ([HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
    -> [Located (HsType GhcPs)])
-> [Located (HsType GhcPs)]
forall a b. a -> (a -> b) -> b
& (HsImplicitBndrs GhcPs (Located (HsType GhcPs))
 -> Located (HsType GhcPs))
-> [HsImplicitBndrs GhcPs (Located (HsType GhcPs))]
-> [Located (HsType GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsImplicitBndrs GhcPs (Located (HsType GhcPs))
-> Located (HsType GhcPs)
forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body

    headTy :: Maybe (Located (HsType GhcPs))
headTy =
      [Located (HsType GhcPs)] -> Maybe (Located (HsType GhcPs))
forall a. [a] -> Maybe a
listToMaybe [Located (HsType GhcPs)]
tys

    tailTy :: [Located (HsType GhcPs)]
tailTy =
      Int -> [Located (HsType GhcPs)] -> [Located (HsType GhcPs)]
forall a. Int -> [a] -> [a]
drop Int
1 [Located (HsType GhcPs)]
tys

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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"|" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space)
    ((LConDecl GhcPs -> Printer ()) -> [LConDecl GhcPs] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Config -> Int -> LConDecl GhcPs -> Printer ()
putConstructor Config
cfg Int
0) ([LConDecl GhcPs] -> [Printer ()])
-> (DataDecl -> [LConDecl GhcPs]) -> DataDecl -> [Printer ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> [LConDecl GhcPs]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons (HsDataDefn GhcPs -> [LConDecl GhcPs])
-> (DataDecl -> HsDataDefn GhcPs) -> DataDecl -> [LConDecl 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{HsDataDefn GhcPs
LHsQTyVars GhcPs
LexicalFixity
Located RdrName
dataFixity :: LexicalFixity
dataDefn :: HsDataDefn GhcPs
dataTypeVars :: LHsQTyVars GhcPs
dataDeclName :: Located RdrName
dataFixity :: DataDecl -> LexicalFixity
dataDefn :: DataDecl -> HsDataDefn GhcPs
dataTypeVars :: DataDecl -> LHsQTyVars GhcPs
dataDeclName :: DataDecl -> Located RdrName
..} =
  if DataDecl -> Bool
isInfix DataDecl
decl then do
    Maybe (Located (HsTyVarBndr GhcPs))
-> (Located (HsTyVarBndr GhcPs) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Located (HsTyVarBndr GhcPs))
firstTvar (\Located (HsTyVarBndr GhcPs)
t -> Located (HsTyVarBndr GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable Located (HsTyVarBndr GhcPs)
t Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space)
    Located RdrName -> Printer ()
putRdrName Located RdrName
dataDeclName
    Printer ()
space
    Maybe (Located (HsTyVarBndr GhcPs))
-> (Located (HsTyVarBndr GhcPs) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Located (HsTyVarBndr GhcPs))
secondTvar Located (HsTyVarBndr GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable
  else do
    Located RdrName -> Printer ()
putRdrName Located RdrName
dataDeclName
    [Located (HsTyVarBndr GhcPs)]
-> (Located (HsTyVarBndr GhcPs) -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (LHsQTyVars GhcPs -> [Located (HsTyVarBndr GhcPs)]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
hsq_explicit LHsQTyVars GhcPs
dataTypeVars) (\Located (HsTyVarBndr GhcPs)
t -> Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Located (HsTyVarBndr GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable Located (HsTyVarBndr GhcPs)
t)

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

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

putConstructor :: Config -> Int -> Located (ConDecl GhcPs) -> P ()
putConstructor :: Config -> Int -> LConDecl GhcPs -> Printer ()
putConstructor Config
cfg Int
consIndent (L SrcSpan
_ ConDecl GhcPs
cons) = case ConDecl GhcPs
cons of
  ConDeclGADT{[Located (IdP GhcPs)]
Maybe (LHsContext GhcPs)
Maybe LHsDocString
LHsQTyVars GhcPs
HsConDeclDetails GhcPs
XConDeclGADT GhcPs
Located Bool
Located (HsType GhcPs)
con_g_ext :: forall pass. ConDecl pass -> XConDeclGADT pass
con_names :: forall pass. ConDecl pass -> [Located (IdP pass)]
con_forall :: forall pass. ConDecl pass -> Located Bool
con_qvars :: forall pass. ConDecl pass -> LHsQTyVars pass
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
con_doc :: Maybe LHsDocString
con_res_ty :: Located (HsType GhcPs)
con_args :: HsConDeclDetails GhcPs
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_qvars :: LHsQTyVars GhcPs
con_forall :: Located Bool
con_names :: [Located (IdP GhcPs)]
con_g_ext :: XConDeclGADT GhcPs
..} -> do
    -- Put argument to constructor first:
    case HsConDeclDetails GhcPs
con_args of
      PrefixCon [Located (HsType GhcPs)]
_ -> do
        Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep
          (Printer ()
comma Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space)
          ((Located RdrName -> Printer ())
-> [Located RdrName] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located RdrName -> Printer ()
putRdrName [Located (IdP GhcPs)]
[Located RdrName]
con_names)

      InfixCon Located (HsType GhcPs)
arg1 Located (HsType GhcPs)
arg2 -> do
        Located (HsType GhcPs) -> Printer ()
putType Located (HsType GhcPs)
arg1
        Printer ()
space
        [Located RdrName] -> (Located RdrName -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Located (IdP GhcPs)]
[Located RdrName]
con_names Located RdrName -> Printer ()
putRdrName
        Printer ()
space
        Located (HsType GhcPs) -> Printer ()
putType Located (HsType GhcPs)
arg2
      RecCon Located [LConDeclField GhcPs]
_ ->
        String -> Printer ()
forall a. HasCallStack => String -> a
error (String -> Printer ()) -> (Lines -> String) -> Lines -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> String
forall a. Monoid a => [a] -> a
mconcat (Lines -> Printer ()) -> Lines -> Printer ()
forall a b. (a -> b) -> a -> b
$
          [ String
"Language.Haskell.Stylish.Step.Data.putConstructor: "
          , String
"encountered a GADT with record constructors, not supported yet"
          ]

    -- Put type of constructor:
    Printer ()
space
    String -> Printer ()
putText String
"::"
    Printer ()
space

    Located Bool -> [Located (HsTyVarBndr GhcPs)] -> Printer ()
putForAll Located Bool
con_forall ([Located (HsTyVarBndr GhcPs)] -> Printer ())
-> [Located (HsTyVarBndr GhcPs)] -> Printer ()
forall a b. (a -> b) -> a -> b
$ LHsQTyVars GhcPs -> [Located (HsTyVarBndr GhcPs)]
forall pass. LHsQTyVars pass -> [LHsTyVarBndr pass]
hsq_explicit LHsQTyVars GhcPs
con_qvars
    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 (Config -> [Located (HsType GhcPs)] -> Printer ()
putContext Config
cfg ([Located (HsType GhcPs)] -> Printer ())
-> (LHsContext GhcPs -> [Located (HsType GhcPs)])
-> LHsContext GhcPs
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsContext GhcPs -> [Located (HsType GhcPs)]
forall a. Located a -> a
unLocated)
    Located (HsType GhcPs) -> Printer ()
putType Located (HsType GhcPs)
con_res_ty

  XConDecl XXConDecl GhcPs
x ->
    NoExtCon -> Printer ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDecl GhcPs
x
  ConDeclH98{[Located (HsTyVarBndr GhcPs)]
Maybe (LHsContext GhcPs)
Maybe LHsDocString
HsConDeclDetails GhcPs
XConDeclH98 GhcPs
Located Bool
Located (IdP GhcPs)
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> Located (IdP pass)
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr pass]
con_doc :: Maybe LHsDocString
con_args :: HsConDeclDetails GhcPs
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_ex_tvs :: [Located (HsTyVarBndr GhcPs)]
con_forall :: Located Bool
con_name :: Located (IdP GhcPs)
con_ext :: XConDeclH98 GhcPs
con_forall :: forall pass. ConDecl pass -> Located Bool
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
..} -> do
    Located Bool -> [Located (HsTyVarBndr GhcPs)] -> Printer ()
putForAll Located Bool
con_forall [Located (HsTyVarBndr 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 (Config -> [Located (HsType GhcPs)] -> Printer ()
putContext Config
cfg ([Located (HsType GhcPs)] -> Printer ())
-> (LHsContext GhcPs -> [Located (HsType GhcPs)])
-> LHsContext GhcPs
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsContext GhcPs -> [Located (HsType GhcPs)]
forall a. Located a -> a
unLocated)
    case HsConDeclDetails GhcPs
con_args of
      InfixCon Located (HsType GhcPs)
arg1 Located (HsType GhcPs)
arg2 -> do
        Located (HsType GhcPs) -> Printer ()
putType Located (HsType GhcPs)
arg1
        Printer ()
space
        Located RdrName -> Printer ()
putRdrName Located (IdP GhcPs)
Located RdrName
con_name
        Printer ()
space
        Located (HsType GhcPs) -> Printer ()
putType Located (HsType GhcPs)
arg2
      PrefixCon [Located (HsType GhcPs)]
xs -> do
        Located RdrName -> Printer ()
putRdrName Located (IdP GhcPs)
Located RdrName
con_name
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Located (HsType GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located (HsType GhcPs)]
xs) Printer ()
space
        Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep Printer ()
space ((Located (HsType GhcPs) -> Printer ())
-> [Located (HsType GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (HsType GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable [Located (HsType GhcPs)]
xs)
      RecCon (L SrcSpan
recPos (L SrcSpan
posFirst ConDeclField GhcPs
firstArg : [LConDeclField GhcPs]
args)) -> do
        Located RdrName -> Printer ()
putRdrName Located (IdP GhcPs)
Located RdrName
con_name
        Printer ()
skipToBrace
        Int
bracePos <- Printer Int
getCurrentLineLength
        String -> Printer ()
putText String
"{"
        let fieldPos :: Int
fieldPos = Int
bracePos Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
        Printer ()
space

        -- Unless everything's configured to be on the same line, put pending
        -- comments
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Config -> Indent
cFirstField Config
cfg Indent -> Indent -> Bool
forall a. Eq a => a -> a -> Bool
== Indent
SameLine) do
          SrcSpan -> P [AnnotationComment]
removeCommentTo SrcSpan
posFirst P [AnnotationComment]
-> ([AnnotationComment] -> Printer ()) -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AnnotationComment -> Printer ())
-> [AnnotationComment] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \AnnotationComment
c -> AnnotationComment -> Printer ()
putComment AnnotationComment
c Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
sepDecl Int
bracePos

        -- Put first decl field
        Int -> Printer ()
pad Int
fieldPos Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Config -> ConDeclField GhcPs -> Printer ()
putConDeclField Config
cfg ConDeclField GhcPs
firstArg
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Config -> Indent
cFirstField Config
cfg Indent -> Indent -> Bool
forall a. Eq a => a -> a -> Bool
== Indent
SameLine) (SrcSpan -> Printer ()
putEolComment SrcSpan
posFirst)

        -- Put tail decl fields
        [LConDeclField GhcPs]
-> (LConDeclField GhcPs -> Printer ()) -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [LConDeclField GhcPs]
args \(L SrcSpan
pos ConDeclField GhcPs
arg) -> do
          Int -> Printer ()
sepDecl Int
bracePos
          SrcSpan -> P [AnnotationComment]
removeCommentTo SrcSpan
pos P [AnnotationComment]
-> ([AnnotationComment] -> Printer ()) -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AnnotationComment -> Printer ())
-> [AnnotationComment] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \AnnotationComment
c ->
            Int -> Printer ()
spaces (Config -> Int
cFieldComment Config
cfg) Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnotationComment -> Printer ()
putComment AnnotationComment
c Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
sepDecl Int
bracePos
          Printer ()
comma
          Printer ()
space
          Config -> ConDeclField GhcPs -> Printer ()
putConDeclField Config
cfg ConDeclField GhcPs
arg
          SrcSpan -> Printer ()
putEolComment SrcSpan
pos

        -- Print docstr after final field
        SrcSpan -> P [AnnotationComment]
removeCommentToEnd SrcSpan
recPos P [AnnotationComment]
-> ([AnnotationComment] -> Printer ()) -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (AnnotationComment -> Printer ())
-> [AnnotationComment] -> Printer ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \AnnotationComment
c ->
          Int -> Printer ()
sepDecl Int
bracePos Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Printer ()
spaces (Config -> Int
cFieldComment Config
cfg) Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> AnnotationComment -> Printer ()
putComment AnnotationComment
c

        -- Print whitespace to closing brace
        Int -> Printer ()
sepDecl Int
bracePos Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"}"
      RecCon (L SrcSpan
_ []) -> do
        Printer ()
skipToBrace Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"{"
        Printer ()
skipToBrace Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"}"

    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 (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 (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 (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 (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 -> Located (ConDecl GhcPs) -> P ()
putNewtypeConstructor :: Config -> LConDecl GhcPs -> Printer ()
putNewtypeConstructor Config
cfg (L SrcSpan
_ ConDecl GhcPs
cons) = case ConDecl GhcPs
cons of
  ConDeclH98{[Located (HsTyVarBndr GhcPs)]
Maybe (LHsContext GhcPs)
Maybe LHsDocString
HsConDeclDetails GhcPs
XConDeclH98 GhcPs
Located Bool
Located (IdP GhcPs)
con_doc :: Maybe LHsDocString
con_args :: HsConDeclDetails GhcPs
con_mb_cxt :: Maybe (LHsContext GhcPs)
con_ex_tvs :: [Located (HsTyVarBndr GhcPs)]
con_forall :: Located Bool
con_name :: Located (IdP GhcPs)
con_ext :: XConDeclH98 GhcPs
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> Located (IdP pass)
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr pass]
con_forall :: forall pass. ConDecl pass -> Located Bool
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
..} ->
    Located RdrName -> Printer ()
putRdrName Located (IdP GhcPs)
Located RdrName
con_name Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> case HsConDeclDetails GhcPs
con_args of
      PrefixCon [Located (HsType GhcPs)]
xs -> do
        Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Located (HsType GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located (HsType GhcPs)]
xs) Printer ()
space
        Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep Printer ()
space ((Located (HsType GhcPs) -> Printer ())
-> [Located (HsType GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (HsType GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable [Located (HsType GhcPs)]
xs)
      RecCon (L SrcSpan
_ [L SrcSpan
_posFirst ConDeclField GhcPs
firstArg]) -> do
        Printer ()
space
        String -> Printer ()
putText String
"{"
        Printer ()
space
        Config -> ConDeclField GhcPs -> Printer ()
putConDeclField Config
cfg ConDeclField GhcPs
firstArg
        Printer ()
space
        String -> Printer ()
putText String
"}"
      RecCon (L SrcSpan
_ [LConDeclField GhcPs]
_args) ->
        String -> Printer ()
forall a. HasCallStack => String -> a
error (String -> Printer ()) -> (Lines -> String) -> Lines -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> String
forall a. Monoid a => [a] -> a
mconcat (Lines -> Printer ()) -> Lines -> Printer ()
forall a b. (a -> b) -> a -> b
$
          [ String
"Language.Haskell.Stylish.Step.Data.putNewtypeConstructor: "
          , String
"encountered newtype with several arguments"
          ]
      InfixCon {} ->
        String -> Printer ()
forall a. HasCallStack => String -> a
error (String -> Printer ()) -> (Lines -> String) -> Lines -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> String
forall a. Monoid a => [a] -> a
mconcat (Lines -> Printer ()) -> Lines -> Printer ()
forall a b. (a -> b) -> a -> b
$
          [ String
"Language.Haskell.Stylish.Step.Data.putNewtypeConstructor: "
          , String
"infix newtype constructor"
          ]
  XConDecl XXConDecl GhcPs
x ->
    NoExtCon -> Printer ()
forall a. NoExtCon -> a
noExtCon NoExtCon
XXConDecl GhcPs
x
  ConDeclGADT{} ->
    String -> Printer ()
forall a. HasCallStack => String -> a
error (String -> Printer ()) -> (Lines -> String) -> Lines -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> String
forall a. Monoid a => [a] -> a
mconcat (Lines -> Printer ()) -> Lines -> Printer ()
forall a b. (a -> b) -> a -> b
$
      [ String
"Language.Haskell.Stylish.Step.Data.putNewtypeConstructor: "
      , String
"GADT encountered in newtype"
      ]

putForAll :: Located Bool -> [Located (HsTyVarBndr GhcPs)] -> P ()
putForAll :: Located Bool -> [Located (HsTyVarBndr GhcPs)] -> Printer ()
putForAll Located Bool
forall [Located (HsTyVarBndr GhcPs)]
ex_tvs =
  Bool -> Printer () -> Printer ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Located Bool -> Bool
forall a. Located a -> a
unLocated Located Bool
forall) do
    String -> Printer ()
putText String
"forall"
    Printer ()
space
    Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep Printer ()
space ((Located (HsTyVarBndr GhcPs) -> Printer ())
-> [Located (HsTyVarBndr GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (HsTyVarBndr GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable [Located (HsTyVarBndr GhcPs)]
ex_tvs)
    Printer ()
dot
    Printer ()
space

putContext :: Config -> HsContext GhcPs -> P ()
putContext :: Config -> [Located (HsType GhcPs)] -> Printer ()
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
..} = Printer () -> Printer () -> Printer ()
forall a b. P a -> P b -> P a
suffix (Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"=>" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) (Printer () -> Printer ())
-> ([Located (HsType GhcPs)] -> Printer ())
-> [Located (HsType GhcPs)]
-> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
  [L SrcSpan
_ (HsParTy XParTy GhcPs
_ Located (HsType GhcPs)
tp)] | Bool
cCurriedContext ->
    Located (HsType GhcPs) -> Printer ()
putType Located (HsType GhcPs)
tp
  [Located (HsType GhcPs)
ctx] ->
    Located (HsType GhcPs) -> Printer ()
putType Located (HsType GhcPs)
ctx
  [Located (HsType GhcPs)]
ctxs | Bool
cCurriedContext ->
    Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep (Printer ()
space Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Printer ()
putText String
"=>" Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) ((Located (HsType GhcPs) -> Printer ())
-> [Located (HsType GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (HsType GhcPs) -> Printer ()
putType [Located (HsType GhcPs)]
ctxs)
  [Located (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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space) ((Located (HsType GhcPs) -> Printer ())
-> [Located (HsType GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (HsType GhcPs) -> Printer ()
putType [Located (HsType GhcPs)]
ctxs)

putConDeclField :: Config -> ConDeclField GhcPs -> P ()
putConDeclField :: Config -> ConDeclField GhcPs -> Printer ()
putConDeclField Config
cfg = \case
  ConDeclField{[LFieldOcc GhcPs]
Maybe LHsDocString
XConDeclField GhcPs
Located (HsType 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 LHsDocString
cd_fld_doc :: Maybe LHsDocString
cd_fld_type :: Located (HsType GhcPs)
cd_fld_names :: [LFieldOcc GhcPs]
cd_fld_ext :: XConDeclField GhcPs
..} -> do
    Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep
      (Printer ()
comma Printer () -> Printer () -> Printer ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Printer ()
space)
      ((LFieldOcc GhcPs -> Printer ())
-> [LFieldOcc GhcPs] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LFieldOcc GhcPs -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable [LFieldOcc GhcPs]
cd_fld_names)
    Printer ()
space
    String -> Printer ()
putText String
"::"
    Printer ()
space
    Config -> Located (HsType GhcPs) -> Printer ()
putType' Config
cfg Located (HsType GhcPs)
cd_fld_type
  XConDeclField{} ->
    String -> Printer ()
forall a. HasCallStack => String -> a
error (String -> Printer ()) -> (Lines -> String) -> Lines -> Printer ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lines -> String
forall a. Monoid a => [a] -> a
mconcat (Lines -> Printer ()) -> Lines -> Printer ()
forall a b. (a -> b) -> a -> b
$
      [ String
"Language.Haskell.Stylish.Step.Data.putConDeclField: "
      , String
"XConDeclField encountered"
      ]

-- | A variant of 'putType' that takes 'cCurriedContext' into account
putType' :: Config -> Located (HsType GhcPs) -> P ()
putType' :: Config -> Located (HsType GhcPs) -> Printer ()
putType' Config
cfg = \case
  L SrcSpan
_ (HsForAllTy XForAllTy GhcPs
NoExtField ForallVisFlag
vis [Located (HsTyVarBndr GhcPs)]
bndrs Located (HsType GhcPs)
tp) -> do
    String -> Printer ()
putText String
"forall"
    Printer ()
space
    Printer () -> [Printer ()] -> Printer ()
forall a. P a -> [P a] -> Printer ()
sep Printer ()
space ((Located (HsTyVarBndr GhcPs) -> Printer ())
-> [Located (HsTyVarBndr GhcPs)] -> [Printer ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located (HsTyVarBndr GhcPs) -> Printer ()
forall a. Outputable a => a -> Printer ()
putOutputable [Located (HsTyVarBndr GhcPs)]
bndrs)
    String -> Printer ()
putText
      if ForallVisFlag
vis ForallVisFlag -> ForallVisFlag -> Bool
forall a. Eq a => a -> a -> Bool
== ForallVisFlag
ForallVis then String
"->"
      else String
"."
    Printer ()
space
    Config -> Located (HsType GhcPs) -> Printer ()
putType' Config
cfg Located (HsType GhcPs)
tp
  L SrcSpan
_ (HsQualTy XQualTy GhcPs
NoExtField LHsContext GhcPs
ctx Located (HsType GhcPs)
tp) -> do
    Config -> [Located (HsType GhcPs)] -> Printer ()
putContext Config
cfg (LHsContext GhcPs -> [Located (HsType GhcPs)]
forall a. Located a -> a
unLocated LHsContext GhcPs
ctx)
    Config -> Located (HsType GhcPs) -> Printer ()
putType' Config
cfg Located (HsType GhcPs)
tp
  Located (HsType GhcPs)
other -> Located (HsType GhcPs) -> Printer ()
putType Located (HsType GhcPs)
other

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

isGADT :: DataDecl -> Bool
isGADT :: DataDecl -> Bool
isGADT = (LConDecl GhcPs -> Bool) -> [LConDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any LConDecl GhcPs -> Bool
forall l pass. GenLocated l (ConDecl pass) -> Bool
isGADTCons ([LConDecl GhcPs] -> Bool)
-> (DataDecl -> [LConDecl GhcPs]) -> DataDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> [LConDecl GhcPs]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons (HsDataDefn GhcPs -> [LConDecl GhcPs])
-> (DataDecl -> HsDataDefn GhcPs) -> DataDecl -> [LConDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDecl -> HsDataDefn GhcPs
dataDefn
  where
    isGADTCons :: GenLocated l (ConDecl pass) -> Bool
isGADTCons = \case
      L l
_ (ConDeclGADT {}) -> Bool
True
      GenLocated l (ConDecl pass)
_                    -> Bool
False

isNewtype :: DataDecl -> Bool
isNewtype :: DataDecl -> Bool
isNewtype = (NewOrData -> NewOrData -> Bool
forall a. Eq a => a -> a -> Bool
== NewOrData
NewType) (NewOrData -> Bool) -> (DataDecl -> NewOrData) -> DataDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> NewOrData
forall pass. HsDataDefn pass -> NewOrData
dd_ND (HsDataDefn GhcPs -> NewOrData)
-> (DataDecl -> HsDataDefn GhcPs) -> DataDecl -> NewOrData
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
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 = (LConDecl GhcPs -> Bool) -> [LConDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LConDecl GhcPs -> Bool
forall l pass. GenLocated l (ConDecl pass) -> Bool
isUnary ([LConDecl GhcPs] -> Bool)
-> (DataDecl -> [LConDecl GhcPs]) -> DataDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> [LConDecl GhcPs]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons (HsDataDefn GhcPs -> [LConDecl GhcPs])
-> (DataDecl -> HsDataDefn GhcPs) -> DataDecl -> [LConDecl GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDecl -> HsDataDefn GhcPs
dataDefn
  where
    isUnary :: GenLocated l (ConDecl pass) -> Bool
isUnary = \case
      L l
_ (ConDeclH98 {[LHsTyVarBndr pass]
Maybe (LHsContext pass)
Maybe LHsDocString
HsConDeclDetails pass
XConDeclH98 pass
Located Bool
Located (IdP pass)
con_doc :: Maybe LHsDocString
con_args :: HsConDeclDetails pass
con_mb_cxt :: Maybe (LHsContext pass)
con_ex_tvs :: [LHsTyVarBndr pass]
con_forall :: Located Bool
con_name :: Located (IdP pass)
con_ext :: XConDeclH98 pass
con_ext :: forall pass. ConDecl pass -> XConDeclH98 pass
con_name :: forall pass. ConDecl pass -> Located (IdP pass)
con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr pass]
con_forall :: forall pass. ConDecl pass -> Located Bool
con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_args :: forall pass. ConDecl pass -> HsConDeclDetails pass
con_doc :: forall pass. ConDecl pass -> Maybe LHsDocString
..}) -> case HsConDeclDetails pass
con_args of
        PrefixCon [] -> Bool
True
        HsConDeclDetails pass
_            -> Bool
False
      GenLocated l (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
. [LConDecl GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([LConDecl GhcPs] -> Bool)
-> (DataDecl -> [LConDecl GhcPs]) -> DataDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> [LConDecl GhcPs]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons (HsDataDefn GhcPs -> [LConDecl GhcPs])
-> (DataDecl -> HsDataDefn GhcPs) -> DataDecl -> [LConDecl 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
. [LConDecl GhcPs] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([LConDecl GhcPs] -> Int)
-> (DataDecl -> [LConDecl GhcPs]) -> DataDecl -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> [LConDecl GhcPs]
forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons (HsDataDefn GhcPs -> [LConDecl GhcPs])
-> (DataDecl -> HsDataDefn GhcPs) -> DataDecl -> [LConDecl 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
. [LHsDerivingClause GhcPs] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([LHsDerivingClause GhcPs] -> Bool)
-> (DataDecl -> [LHsDerivingClause GhcPs]) -> DataDecl -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDeriving GhcPs -> [LHsDerivingClause GhcPs]
forall a. Located a -> a
unLocated (HsDeriving GhcPs -> [LHsDerivingClause GhcPs])
-> (DataDecl -> HsDeriving GhcPs)
-> DataDecl
-> [LHsDerivingClause GhcPs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsDataDefn GhcPs -> HsDeriving GhcPs
forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs (HsDataDefn GhcPs -> HsDeriving GhcPs)
-> (DataDecl -> HsDataDefn GhcPs) -> DataDecl -> HsDeriving GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataDecl -> HsDataDefn GhcPs
dataDefn