{-# LANGUAGE NamedFieldPuns #-}
{-
    Suggest newtype instead of data for type declarations that have
    only one field. Don't suggest newtype for existentially
    quantified data types because it is not valid.

<TEST>
data Foo = Foo Int -- newtype Foo = Foo Int
data Foo = Foo Int deriving (Show, Eq) -- newtype Foo = Foo Int deriving (Show, Eq)
data Foo = Foo { field :: Int } deriving Show -- newtype Foo = Foo { field :: Int } deriving Show
data Foo a b = Foo a -- newtype Foo a b = Foo a
data Foo = Foo { field1, field2 :: Int}
data S a = forall b . Show b => S b
{-# LANGUAGE RankNTypes #-}; data S a = forall b . Show b => S b
{-# LANGUAGE RankNTypes #-}; data Foo = Foo (forall a . a) -- newtype Foo = Foo (forall a. a)
data Color a = Red a | Green a | Blue a
data Pair a b = Pair a b
data Foo = Bar
data Foo a = Eq a => MkFoo a
data Foo a = () => Foo a -- newtype Foo a = () => Foo a
data X = Y {-# UNPACK #-} !Int -- newtype X = Y Int
data A = A {b :: !C} -- newtype A = A {b :: C}
data A = A Int#
data A = A (MutableByteArray# s)
{-# LANGUAGE UnboxedTuples #-}; data WithAnn x = WithAnn (# Ann, x #)
{-# LANGUAGE UnboxedTuples #-}; data WithAnn x = WithAnn {getWithAnn :: (# Ann, x #)}
data A = A () -- newtype A = A ()
newtype Foo = Foo Int deriving (Show, Eq) --
newtype Foo = Foo { getFoo :: Int } deriving (Show, Eq) --
newtype Foo = Foo Int deriving stock Show
data instance Foo Int = Bar Bool -- newtype instance Foo Int = Bar Bool
data instance Foo Int = Bar {field :: Bool} -- newtype instance Foo Int = Bar {field :: Bool}
data instance Foo Int = Bar {field :: Int#}
data instance Foo Int = Bar
data instance Foo Int = Bar {field1 :: Bool, field2 :: ()}
newtype instance Foo Int = Bar Bool deriving (Show, Eq) --
newtype instance Foo Int = Bar {field :: Bool} deriving Show --
newtype instance Foo Int = Bar {field :: Bool} deriving stock Show
{-# LANGUAGE RankNTypes #-}; data instance Foo Int = forall a. Show a => Foo a
</TEST>
-}
module Hint.NewType (newtypeHint) where

import Hint.Type (Idea, DeclHint, Note(DecreasesLaziness), ideaNote, ignoreNoSuggestion, suggestN)

import Data.List (isSuffixOf)
import GHC.Hs.Decls
import GHC.Hs
import GHC.Types.SrcLoc
import Data.Generics.Uniplate.Data
import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable

newtypeHint :: DeclHint
newtypeHint :: DeclHint
newtypeHint Scope
_ ModuleEx
_ LHsDecl GhcPs
x = LHsDecl GhcPs -> [Idea]
newtypeHintDecl LHsDecl GhcPs
x [Idea] -> [Idea] -> [Idea]
forall a. [a] -> [a] -> [a]
++ LHsDecl GhcPs -> [Idea]
newTypeDerivingStrategiesHintDecl LHsDecl GhcPs
x

newtypeHintDecl :: LHsDecl GhcPs -> [Idea]
newtypeHintDecl :: LHsDecl GhcPs -> [Idea]
newtypeHintDecl LHsDecl GhcPs
old
    | Just WarnNewtype{LHsDecl GhcPs
newDecl :: LHsDecl GhcPs
newDecl :: WarnNewtype -> LHsDecl GhcPs
newDecl, HsType GhcPs
insideType :: HsType GhcPs
insideType :: WarnNewtype -> HsType GhcPs
insideType} <- LHsDecl GhcPs -> Maybe WarnNewtype
singleSimpleField LHsDecl GhcPs
old
    = [(String -> Located (HsDecl GhcPs) -> Located (HsDecl GhcPs) -> Idea
forall a. Outputable a => String -> Located a -> Located a -> Idea
suggestN String
"Use newtype instead of data" (LocatedAn AnnListItem (HsDecl GhcPs) -> Located (HsDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsDecl GhcPs
LocatedAn AnnListItem (HsDecl GhcPs)
old) (LocatedAn AnnListItem (HsDecl GhcPs) -> Located (HsDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsDecl GhcPs
LocatedAn AnnListItem (HsDecl GhcPs)
newDecl))
            {ideaNote = [DecreasesLaziness | warnBang insideType]}]
newtypeHintDecl LHsDecl GhcPs
_ = []

newTypeDerivingStrategiesHintDecl :: LHsDecl GhcPs -> [Idea]
newTypeDerivingStrategiesHintDecl :: LHsDecl GhcPs -> [Idea]
newTypeDerivingStrategiesHintDecl decl :: LHsDecl GhcPs
decl@(L SrcSpanAnnA
_ (TyClD XTyClD GhcPs
_ (DataDecl XDataDecl GhcPs
_ LIdP GhcPs
_ LHsQTyVars GhcPs
_ LexicalFixity
_ HsDataDefn GhcPs
dataDef))) =
    [String -> Located (HsDecl GhcPs) -> Idea
forall a. Outputable a => String -> Located a -> Idea
ignoreNoSuggestion String
"Use DerivingStrategies" (LocatedAn AnnListItem (HsDecl GhcPs) -> Located (HsDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsDecl GhcPs
LocatedAn AnnListItem (HsDecl GhcPs)
decl) | HsDataDefn GhcPs -> Bool
shouldSuggestStrategies HsDataDefn GhcPs
dataDef]
newTypeDerivingStrategiesHintDecl decl :: LHsDecl GhcPs
decl@(L SrcSpanAnnA
_ (InstD XInstD GhcPs
_ (DataFamInstD XDataFamInstD GhcPs
_ (DataFamInstDecl ((FamEqn XCFamEqn GhcPs (HsDataDefn GhcPs)
_ LIdP GhcPs
_ HsOuterFamEqnTyVarBndrs GhcPs
_ HsTyPats GhcPs
_ LexicalFixity
_ HsDataDefn GhcPs
dataDef)))))) =
    [String -> Located (HsDecl GhcPs) -> Idea
forall a. Outputable a => String -> Located a -> Idea
ignoreNoSuggestion String
"Use DerivingStrategies" (LocatedAn AnnListItem (HsDecl GhcPs) -> Located (HsDecl GhcPs)
forall a e. LocatedAn a e -> Located e
reLoc LHsDecl GhcPs
LocatedAn AnnListItem (HsDecl GhcPs)
decl) | HsDataDefn GhcPs -> Bool
shouldSuggestStrategies HsDataDefn GhcPs
dataDef]
newTypeDerivingStrategiesHintDecl LHsDecl GhcPs
_ = []

-- | Determine if the given data definition should use deriving strategies.
shouldSuggestStrategies :: HsDataDefn GhcPs -> Bool
shouldSuggestStrategies :: HsDataDefn GhcPs -> Bool
shouldSuggestStrategies HsDataDefn GhcPs
dataDef = Bool -> Bool
not (HsDataDefn GhcPs -> Bool
isData HsDataDefn GhcPs
dataDef) Bool -> Bool -> Bool
&& Bool -> Bool
not (HsDataDefn GhcPs -> Bool
hasAllStrategies HsDataDefn GhcPs
dataDef)

hasAllStrategies :: HsDataDefn GhcPs -> Bool
hasAllStrategies :: HsDataDefn GhcPs -> Bool
hasAllStrategies (HsDataDefn XCHsDataDefn GhcPs
_ Maybe (LHsContext GhcPs)
_ Maybe (XRec GhcPs CType)
_ Maybe (LHsKind GhcPs)
_ DataDefnCons (LConDecl GhcPs)
_  HsDeriving GhcPs
xs) = (GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs) -> Bool)
-> [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LHsDerivingClause GhcPs -> Bool
GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs) -> Bool
hasStrategyClause HsDeriving GhcPs
[GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcPs)]
xs

isData :: HsDataDefn GhcPs -> Bool
isData :: HsDataDefn GhcPs -> Bool
isData (HsDataDefn XCHsDataDefn GhcPs
_ Maybe (LHsContext GhcPs)
_ Maybe (XRec GhcPs CType)
_ Maybe (LHsKind GhcPs)
_ (NewTypeCon LConDecl GhcPs
_) HsDeriving GhcPs
_) = Bool
False
isData (HsDataDefn XCHsDataDefn GhcPs
_ Maybe (LHsContext GhcPs)
_ Maybe (XRec GhcPs CType)
_ Maybe (LHsKind GhcPs)
_ (DataTypeCons Bool
_ [LConDecl GhcPs]
_) HsDeriving GhcPs
_) = Bool
True

hasStrategyClause :: LHsDerivingClause GhcPs -> Bool
hasStrategyClause :: LHsDerivingClause GhcPs -> Bool
hasStrategyClause (L SrcAnn NoEpAnns
_ (HsDerivingClause XCHsDerivingClause GhcPs
_ (Just LDerivStrategy GhcPs
_) LDerivClauseTys GhcPs
_)) = Bool
True
hasStrategyClause LHsDerivingClause GhcPs
_ = Bool
False

data WarnNewtype = WarnNewtype
    { WarnNewtype -> LHsDecl GhcPs
newDecl :: LHsDecl GhcPs
    , WarnNewtype -> HsType GhcPs
insideType :: HsType GhcPs
    }

-- | Given a declaration, returns the suggested \"newtype\"ized declaration following these guidelines:
-- * Types ending in a \"#\" are __ignored__, because they are usually unboxed primitives - @data X = X Int#@
-- * @ExistentialQuantification@ stuff is __ignored__ - @data X = forall t. X t@
-- * Constructors with (nonempty) constraints are __ignored__ - @data X a = (Eq a) => X a@
-- * Single field constructors get newtyped - @data X = X Int@ -> @newtype X = X Int@
-- * Single record field constructors get newtyped - @data X = X {getX :: Int}@ -> @newtype X = X {getX :: Int}@
-- * All other declarations are ignored.
singleSimpleField :: LHsDecl GhcPs -> Maybe WarnNewtype
singleSimpleField :: LHsDecl GhcPs -> Maybe WarnNewtype
singleSimpleField (L SrcSpanAnnA
loc (TyClD XTyClD GhcPs
ext decl :: TyClDecl GhcPs
decl@(DataDecl XDataDecl GhcPs
_ LIdP GhcPs
_ LHsQTyVars GhcPs
_ LexicalFixity
_ HsDataDefn GhcPs
dataDef)))
    | Just HsType GhcPs
inType <- HsDataDefn GhcPs -> Maybe (HsType GhcPs)
simpleHsDataDefn HsDataDefn GhcPs
dataDef =
        case HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
dropBangs HsDataDefn GhcPs
dataDef of
          DataTypeCons Bool
False [LConDecl GhcPs
con] ->
            WarnNewtype -> Maybe WarnNewtype
forall a. a -> Maybe a
Just WarnNewtype
              { newDecl :: LHsDecl GhcPs
newDecl = SrcSpanAnnA -> HsDecl GhcPs -> LocatedAn AnnListItem (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsDecl GhcPs -> LocatedAn AnnListItem (HsDecl GhcPs))
-> HsDecl GhcPs -> LocatedAn AnnListItem (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XTyClD GhcPs -> TyClDecl GhcPs -> HsDecl GhcPs
forall p. XTyClD p -> TyClDecl p -> HsDecl p
TyClD XTyClD GhcPs
ext TyClDecl GhcPs
decl {tcdDataDefn = dataDef
                  { dd_cons = NewTypeCon con }}
              , insideType :: HsType GhcPs
insideType = HsType GhcPs
inType
              }
          DataTypeCons Bool
True [LConDecl GhcPs
_] -> Maybe WarnNewtype
forall a. Maybe a
Nothing -- Extension "TypeData": `type data T x = ...`
          DataDefnCons (LConDecl GhcPs)
_ -> Maybe WarnNewtype
forall a. Maybe a
Nothing
singleSimpleField (L SrcSpanAnnA
loc (InstD XInstD GhcPs
ext (DataFamInstD XDataFamInstD GhcPs
instExt (DataFamInstDecl famEqn :: FamEqn GhcPs (HsDataDefn GhcPs)
famEqn@(FamEqn XCFamEqn GhcPs (HsDataDefn GhcPs)
_ LIdP GhcPs
_ HsOuterFamEqnTyVarBndrs GhcPs
_ HsTyPats GhcPs
_ LexicalFixity
_ HsDataDefn GhcPs
dataDef)))))
    | Just HsType GhcPs
inType <- HsDataDefn GhcPs -> Maybe (HsType GhcPs)
simpleHsDataDefn HsDataDefn GhcPs
dataDef =
        case HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
dropBangs HsDataDefn GhcPs
dataDef of
          DataTypeCons Bool
False [LConDecl GhcPs
con] ->
            WarnNewtype -> Maybe WarnNewtype
forall a. a -> Maybe a
Just WarnNewtype
              { newDecl :: LHsDecl GhcPs
newDecl = SrcSpanAnnA -> HsDecl GhcPs -> LocatedAn AnnListItem (HsDecl GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
loc (HsDecl GhcPs -> LocatedAn AnnListItem (HsDecl GhcPs))
-> HsDecl GhcPs -> LocatedAn AnnListItem (HsDecl GhcPs)
forall a b. (a -> b) -> a -> b
$ XInstD GhcPs -> InstDecl GhcPs -> HsDecl GhcPs
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD XInstD GhcPs
ext (InstDecl GhcPs -> HsDecl GhcPs) -> InstDecl GhcPs -> HsDecl GhcPs
forall a b. (a -> b) -> a -> b
$ XDataFamInstD GhcPs -> DataFamInstDecl GhcPs -> InstDecl GhcPs
forall pass.
XDataFamInstD pass -> DataFamInstDecl pass -> InstDecl pass
DataFamInstD XDataFamInstD GhcPs
instExt (DataFamInstDecl GhcPs -> InstDecl GhcPs)
-> DataFamInstDecl GhcPs -> InstDecl GhcPs
forall a b. (a -> b) -> a -> b
$ FamEqn GhcPs (HsDataDefn GhcPs) -> DataFamInstDecl GhcPs
forall pass. FamEqn pass (HsDataDefn pass) -> DataFamInstDecl pass
DataFamInstDecl (FamEqn GhcPs (HsDataDefn GhcPs) -> DataFamInstDecl GhcPs)
-> FamEqn GhcPs (HsDataDefn GhcPs) -> DataFamInstDecl GhcPs
forall a b. (a -> b) -> a -> b
$ FamEqn GhcPs (HsDataDefn GhcPs)
famEqn {feqn_rhs = dataDef
                      { dd_cons = NewTypeCon con }}
              , insideType :: HsType GhcPs
insideType = HsType GhcPs
inType
              }
          DataTypeCons Bool
True [LConDecl GhcPs
_] -> Maybe WarnNewtype
forall a. Maybe a
Nothing --  -- Extension "TypeData": `type data T x = ...`
          DataDefnCons (LConDecl GhcPs)
_ -> Maybe WarnNewtype
forall a. Maybe a
Nothing
singleSimpleField LHsDecl GhcPs
_ = Maybe WarnNewtype
forall a. Maybe a
Nothing

dropBangs :: HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
dropBangs :: HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
dropBangs HsDataDefn GhcPs
def =
  case HsDataDefn GhcPs -> DataDefnCons (LConDecl GhcPs)
forall pass. HsDataDefn pass -> DataDefnCons (LConDecl pass)
dd_cons HsDataDefn GhcPs
def of
    NewTypeCon LConDecl GhcPs
a -> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. a -> DataDefnCons a
NewTypeCon (ConDecl GhcPs -> ConDecl GhcPs
dropConsBang (ConDecl GhcPs -> ConDecl GhcPs)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LConDecl GhcPs
GenLocated SrcSpanAnnA (ConDecl GhcPs)
a)
    DataTypeCons Bool
isTypeData [LConDecl GhcPs]
as -> Bool
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> DataDefnCons (GenLocated SrcSpanAnnA (ConDecl GhcPs))
forall a. Bool -> [a] -> DataDefnCons a
DataTypeCons Bool
isTypeData ((GenLocated SrcSpanAnnA (ConDecl GhcPs)
 -> GenLocated SrcSpanAnnA (ConDecl GhcPs))
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDecl GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (ConDecl GhcPs -> ConDecl GhcPs
dropConsBang (ConDecl GhcPs -> ConDecl GhcPs)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
-> GenLocated SrcSpanAnnA (ConDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) [LConDecl GhcPs]
[GenLocated SrcSpanAnnA (ConDecl GhcPs)]
as)

-- | Checks whether its argument is a \"simple\" data definition (see
-- 'singleSimpleField') returning the single thing under its
-- constructor if it is.
simpleHsDataDefn :: HsDataDefn GhcPs -> Maybe (HsType GhcPs)
simpleHsDataDefn :: HsDataDefn GhcPs -> Maybe (HsType GhcPs)
simpleHsDataDefn (HsDataDefn XCHsDataDefn GhcPs
_ Maybe (LHsContext GhcPs)
_ Maybe (XRec GhcPs CType)
_ Maybe (LHsKind GhcPs)
_ (DataTypeCons Bool
_ [L SrcSpanAnnA
_ ConDecl GhcPs
constructor]) HsDeriving GhcPs
_) = ConDecl GhcPs -> Maybe (HsType GhcPs)
simpleCons ConDecl GhcPs
constructor
simpleHsDataDefn HsDataDefn GhcPs
_ = Maybe (HsType GhcPs)
forall a. Maybe a
Nothing

-- | Checks whether its argument is a \"simple\" constructor (see criteria in 'singleSimpleField')
-- returning the type inside the constructor if it is. This is needed for strictness analysis.
simpleCons :: ConDecl GhcPs -> Maybe (HsType GhcPs)
simpleCons :: ConDecl GhcPs -> Maybe (HsType GhcPs)
simpleCons (ConDeclH98 XConDeclH98 GhcPs
_ LIdP GhcPs
_ Bool
_ [] Maybe (LHsContext GhcPs)
context (PrefixCon [] [HsScaled HsArrow GhcPs
_ (L SrcSpanAnnA
_ HsType GhcPs
inType)]) Maybe (LHsDoc GhcPs)
_)
    | Maybe (LHsContext GhcPs) -> Bool
emptyOrNoContext Maybe (LHsContext GhcPs)
context
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HsType GhcPs -> Bool
isUnboxedTuple HsType GhcPs
inType
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HsType GhcPs -> Bool
isHashy HsType GhcPs
inType
    = HsType GhcPs -> Maybe (HsType GhcPs)
forall a. a -> Maybe a
Just HsType GhcPs
inType
simpleCons (ConDeclH98 XConDeclH98 GhcPs
_ LIdP GhcPs
_ Bool
_ [] Maybe (LHsContext GhcPs)
context (RecCon (L SrcSpanAnnL
_ [L SrcSpanAnnA
_ (ConDeclField XConDeclField GhcPs
_ [LFieldOcc GhcPs
_] (L SrcSpanAnnA
_ HsType GhcPs
inType) Maybe (LHsDoc GhcPs)
_)])) Maybe (LHsDoc GhcPs)
_)
    | Maybe (LHsContext GhcPs) -> Bool
emptyOrNoContext Maybe (LHsContext GhcPs)
context
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HsType GhcPs -> Bool
isUnboxedTuple HsType GhcPs
inType
    , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ HsType GhcPs -> Bool
isHashy HsType GhcPs
inType
    = HsType GhcPs -> Maybe (HsType GhcPs)
forall a. a -> Maybe a
Just HsType GhcPs
inType
simpleCons ConDecl GhcPs
_ = Maybe (HsType GhcPs)
forall a. Maybe a
Nothing

isHashy :: HsType GhcPs -> Bool
isHashy :: HsType GhcPs -> Bool
isHashy HsType GhcPs
x = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [String
"#" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` HsType GhcPs -> String
forall a. Outputable a => a -> String
unsafePrettyPrint HsType GhcPs
v | v :: HsType GhcPs
v@HsTyVar{} <- HsType GhcPs -> [HsType GhcPs]
forall on. Uniplate on => on -> [on]
universe HsType GhcPs
x]

warnBang :: HsType GhcPs -> Bool
warnBang :: HsType GhcPs -> Bool
warnBang (HsBangTy XBangTy GhcPs
_ (HsSrcBang SourceText
_ SrcUnpackedness
_ SrcStrictness
SrcStrict) LHsKind GhcPs
_) = Bool
False
warnBang HsType GhcPs
_ = Bool
True

emptyOrNoContext :: Maybe (LHsContext GhcPs) -> Bool
emptyOrNoContext :: Maybe (LHsContext GhcPs) -> Bool
emptyOrNoContext Maybe (LHsContext GhcPs)
Nothing = Bool
True
emptyOrNoContext (Just (L SrcSpanAnnC
_ [])) = Bool
True
emptyOrNoContext Maybe (LHsContext GhcPs)
_ = Bool
False

-- | The \"Bang\" here refers to 'HsSrcBang', which notably also includes @UNPACK@ pragmas!
dropConsBang :: ConDecl GhcPs -> ConDecl GhcPs
-- fields [HsScaled GhcPs (LBangType GhcPs)]
dropConsBang :: ConDecl GhcPs -> ConDecl GhcPs
dropConsBang decl :: ConDecl GhcPs
decl@(ConDeclH98 XConDeclH98 GhcPs
_ LIdP GhcPs
_ Bool
_ [LHsTyVarBndr Specificity GhcPs]
_ Maybe (LHsContext GhcPs)
_ (PrefixCon [] [HsScaled GhcPs (LHsKind GhcPs)]
fields) Maybe (LHsDoc GhcPs)
_) =
    -- decl {con_args = PrefixCon $ map getBangType fields}
    let fs' :: [HsScaled GhcPs (LHsKind GhcPs)]
fs' = (HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
 -> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs)))
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
-> [HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map (\(HsScaled HsArrow GhcPs
s GenLocated SrcSpanAnnA (HsType GhcPs)
lt) -> HsArrow GhcPs
-> GenLocated SrcSpanAnnA (HsType GhcPs)
-> HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))
forall pass a. HsArrow pass -> a -> HsScaled pass a
HsScaled HsArrow GhcPs
s (LHsKind GhcPs -> LHsKind GhcPs
forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
getBangType LHsKind GhcPs
GenLocated SrcSpanAnnA (HsType GhcPs)
lt)) [HsScaled GhcPs (LHsKind GhcPs)]
[HsScaled GhcPs (GenLocated SrcSpanAnnA (HsType GhcPs))]
fields  :: [HsScaled GhcPs (LBangType GhcPs)]
    in ConDecl GhcPs
decl {con_args = PrefixCon [] fs'}
dropConsBang decl :: ConDecl GhcPs
decl@(ConDeclH98 XConDeclH98 GhcPs
_ LIdP GhcPs
_ Bool
_ [LHsTyVarBndr Specificity GhcPs]
_ Maybe (LHsContext GhcPs)
_ (RecCon (L SrcSpanAnnL
recloc [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
conDeclFields)) Maybe (LHsDoc GhcPs)
_) =
    ConDecl GhcPs
decl {con_args = RecCon $ L recloc $ removeUnpacksRecords conDeclFields}
    where
        removeUnpacksRecords :: [LConDeclField GhcPs] -> [LConDeclField GhcPs]
        removeUnpacksRecords :: [LConDeclField GhcPs] -> [LConDeclField GhcPs]
removeUnpacksRecords = (GenLocated SrcSpanAnnA (ConDeclField GhcPs)
 -> GenLocated SrcSpanAnnA (ConDeclField GhcPs))
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
-> [GenLocated SrcSpanAnnA (ConDeclField GhcPs)]
forall a b. (a -> b) -> [a] -> [b]
map (\(L SrcSpanAnnA
conDeclFieldLoc ConDeclField GhcPs
x) -> SrcSpanAnnA
-> ConDeclField GhcPs
-> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
conDeclFieldLoc (ConDeclField GhcPs -> GenLocated SrcSpanAnnA (ConDeclField GhcPs))
-> ConDeclField GhcPs
-> GenLocated SrcSpanAnnA (ConDeclField GhcPs)
forall a b. (a -> b) -> a -> b
$ ConDeclField GhcPs -> ConDeclField GhcPs
removeConDeclFieldUnpacks ConDeclField GhcPs
x)

        removeConDeclFieldUnpacks :: ConDeclField GhcPs -> ConDeclField GhcPs
        removeConDeclFieldUnpacks :: ConDeclField GhcPs -> ConDeclField GhcPs
removeConDeclFieldUnpacks conDeclField :: ConDeclField GhcPs
conDeclField@(ConDeclField XConDeclField GhcPs
_ [LFieldOcc GhcPs]
_ LHsKind GhcPs
fieldType Maybe (LHsDoc GhcPs)
_) =
            ConDeclField GhcPs
conDeclField {cd_fld_type = getBangType fieldType}
dropConsBang ConDecl GhcPs
x = ConDecl GhcPs
x

isUnboxedTuple :: HsType GhcPs -> Bool
isUnboxedTuple :: HsType GhcPs -> Bool
isUnboxedTuple (HsTupleTy XTupleTy GhcPs
_ HsTupleSort
HsUnboxedTuple [LHsKind GhcPs]
_) = Bool
True
isUnboxedTuple HsType GhcPs
_ = Bool
False