{-# 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
, Config -> Indent
cFirstField :: !Indent
, :: !Int
, Config -> Int
cDeriving :: !Int
, Config -> Bool
cBreakEnums :: !Bool
, Config -> Bool
cBreakSingleConstructors :: !Bool
, Config -> Indent
cVia :: !Indent
, Config -> Bool
cCurriedContext :: !Bool
, Config -> Bool
cSortDeriving :: !Bool
, 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)
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
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"
]
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
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
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)
[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
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
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
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
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"
]
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