{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | Type class, type family, and data family instance declarations.
module Ormolu.Printer.Meat.Declaration.Instance
  ( p_clsInstDecl,
    p_tyFamInstDecl,
    p_dataFamInstDecl,
    p_standaloneDerivDecl,
  )
where

import Control.Arrow
import Control.Monad
import Data.Foldable
import Data.Function (on)
import Data.List (sortBy)
import GHC.Hs
import GHC.Types.Basic
import GHC.Types.SrcLoc
import Ormolu.Printer.Combinators
import Ormolu.Printer.Meat.Common
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
import Ormolu.Printer.Meat.Declaration.Data
import Ormolu.Printer.Meat.Declaration.TypeFamily
import Ormolu.Printer.Meat.Type

p_standaloneDerivDecl :: DerivDecl GhcPs -> R ()
p_standaloneDerivDecl :: DerivDecl GhcPs -> R ()
p_standaloneDerivDecl DerivDecl {Maybe (LDerivStrategy GhcPs)
Maybe (XRec GhcPs OverlapMode)
XCDerivDecl GhcPs
LHsSigWcType GhcPs
deriv_type :: forall pass. DerivDecl pass -> LHsSigWcType pass
deriv_strategy :: forall pass. DerivDecl pass -> Maybe (LDerivStrategy pass)
deriv_overlap_mode :: forall pass. DerivDecl pass -> Maybe (XRec pass OverlapMode)
deriv_ext :: forall pass. DerivDecl pass -> XCDerivDecl pass
deriv_overlap_mode :: Maybe (XRec GhcPs OverlapMode)
deriv_strategy :: Maybe (LDerivStrategy GhcPs)
deriv_type :: LHsSigWcType GhcPs
deriv_ext :: XCDerivDecl GhcPs
..} = do
  let typesAfterInstance :: R ()
typesAfterInstance = GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located (HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
-> GenLocated SrcSpanAnnA (HsSigType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (GenLocated SrcSpanAnnA (HsSigType GhcPs))
LHsSigWcType GhcPs
deriv_type) HsSigType GhcPs -> R ()
p_hsSigType
      instTypes :: Bool -> R ()
instTypes Bool
toIndent = R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> R ()
txt Text
"instance"
        R ()
breakpoint
        Maybe (LocatedP OverlapMode) -> R () -> R ()
match_overlap_mode Maybe (LocatedP OverlapMode)
Maybe (XRec GhcPs OverlapMode)
deriv_overlap_mode R ()
breakpoint
        Bool -> R () -> R ()
inciIf Bool
toIndent R ()
typesAfterInstance
  Text -> R ()
txt Text
"deriving"
  R ()
space
  case Maybe (LDerivStrategy GhcPs)
deriv_strategy of
    Maybe (LDerivStrategy GhcPs)
Nothing ->
      Bool -> R ()
instTypes Bool
False
    Just (L _ a) -> case DerivStrategy GhcPs
a of
      StockStrategy XStockStrategy GhcPs
_ -> do
        Text -> R ()
txt Text
"stock "
        Bool -> R ()
instTypes Bool
False
      AnyclassStrategy XAnyClassStrategy GhcPs
_ -> do
        Text -> R ()
txt Text
"anyclass "
        Bool -> R ()
instTypes Bool
False
      NewtypeStrategy XNewtypeStrategy GhcPs
_ -> do
        Text -> R ()
txt Text
"newtype "
        Bool -> R ()
instTypes Bool
False
      ViaStrategy (XViaStrategyPs _ sigTy) -> do
        Text -> R ()
txt Text
"via"
        R ()
breakpoint
        R () -> R ()
inci (GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
sigTy HsSigType GhcPs -> R ()
p_hsSigType)
        R ()
breakpoint
        Bool -> R ()
instTypes Bool
True

p_clsInstDecl :: ClsInstDecl GhcPs -> R ()
p_clsInstDecl :: ClsInstDecl GhcPs -> R ()
p_clsInstDecl ClsInstDecl {[LDataFamInstDecl GhcPs]
[LTyFamInstDecl GhcPs]
[LSig GhcPs]
Maybe (XRec GhcPs OverlapMode)
LHsBinds GhcPs
XCClsInstDecl GhcPs
LHsSigType GhcPs
cid_tyfam_insts :: forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_sigs :: forall pass. ClsInstDecl pass -> [LSig pass]
cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
cid_overlap_mode :: forall pass. ClsInstDecl pass -> Maybe (XRec pass OverlapMode)
cid_ext :: forall pass. ClsInstDecl pass -> XCClsInstDecl pass
cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
cid_overlap_mode :: Maybe (XRec GhcPs OverlapMode)
cid_datafam_insts :: [LDataFamInstDecl GhcPs]
cid_tyfam_insts :: [LTyFamInstDecl GhcPs]
cid_sigs :: [LSig GhcPs]
cid_binds :: LHsBinds GhcPs
cid_poly_ty :: LHsSigType GhcPs
cid_ext :: XCClsInstDecl GhcPs
..} = do
  Text -> R ()
txt Text
"instance"
  -- GHC's AST does not necessarily store each kind of element in source
  -- location order. This happens because different declarations are stored in
  -- different lists. Consequently, to get all the declarations in proper
  -- order, they need to be manually sorted.
  let sigs :: [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
sigs = (GenLocated SrcSpanAnnA (Sig GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (Sig GhcPs) -> SrcSpan)
-> (GenLocated SrcSpanAnnA (Sig GhcPs)
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> GenLocated SrcSpanAnnA (Sig GhcPs)
-> (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (Sig GhcPs -> HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (Sig GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
SigD NoExtField
XSigD GhcPs
NoExtField)) (GenLocated SrcSpanAnnA (Sig GhcPs)
 -> (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (Sig GhcPs)]
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpanAnnA (Sig GhcPs)]
[LSig GhcPs]
cid_sigs
      vals :: [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
vals = (GenLocated SrcSpanAnnA (HsBind GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (HsBind GhcPs) -> SrcSpan)
-> (GenLocated SrcSpanAnnA (HsBind GhcPs)
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> GenLocated SrcSpanAnnA (HsBind GhcPs)
-> (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (HsBind GhcPs -> HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsBind GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XValD GhcPs -> HsBind GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD NoExtField
XValD GhcPs
NoExtField)) (GenLocated SrcSpanAnnA (HsBind GhcPs)
 -> (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
-> [GenLocated SrcSpanAnnA (HsBind GhcPs)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Bag (GenLocated SrcSpanAnnA (HsBind GhcPs))
LHsBinds GhcPs
cid_binds
      tyFamInsts :: [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
tyFamInsts =
        ( GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs) -> SrcSpan)
-> (GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)
-> (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (TyFamInstDecl GhcPs -> HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XInstD GhcPs -> InstDecl GhcPs -> HsDecl GhcPs
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD NoExtField
XInstD GhcPs
NoExtField (InstDecl GhcPs -> HsDecl GhcPs)
-> (TyFamInstDecl GhcPs -> InstDecl GhcPs)
-> TyFamInstDecl GhcPs
-> HsDecl GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XTyFamInstD GhcPs -> TyFamInstDecl GhcPs -> InstDecl GhcPs
forall pass.
XTyFamInstD pass -> TyFamInstDecl pass -> InstDecl pass
TyFamInstD NoExtField
XTyFamInstD GhcPs
NoExtField)
        )
          (GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)
 -> (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpanAnnA (TyFamInstDecl GhcPs)]
[LTyFamInstDecl GhcPs]
cid_tyfam_insts
      dataFamInsts :: [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
dataFamInsts =
        ( GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs) -> SrcSpan
forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA (GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs) -> SrcSpan)
-> (GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)
    -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)
-> (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (DataFamInstDecl GhcPs -> HsDecl GhcPs)
-> GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (XInstD GhcPs -> InstDecl GhcPs -> HsDecl GhcPs
forall p. XInstD p -> InstDecl p -> HsDecl p
InstD NoExtField
XInstD GhcPs
NoExtField (InstDecl GhcPs -> HsDecl GhcPs)
-> (DataFamInstDecl GhcPs -> InstDecl GhcPs)
-> DataFamInstDecl GhcPs
-> HsDecl GhcPs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XDataFamInstD GhcPs -> DataFamInstDecl GhcPs -> InstDecl GhcPs
forall pass.
XDataFamInstD pass -> DataFamInstDecl pass -> InstDecl pass
DataFamInstD XDataFamInstD GhcPs
forall ann. EpAnn ann
EpAnnNotUsed)
        )
          (GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)
 -> (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs)))
-> [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GenLocated SrcSpanAnnA (DataFamInstDecl GhcPs)]
[LDataFamInstDecl GhcPs]
cid_datafam_insts
      allDecls :: [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
allDecls =
        (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> GenLocated SrcSpanAnnA (HsDecl GhcPs)
forall a b. (a, b) -> b
snd ((SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
 -> (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs)) -> Ordering)
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
leftmost_smallest (SrcSpan -> SrcSpan -> Ordering)
-> ((SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs)) -> SrcSpan)
-> (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs)) -> SrcSpan
forall a b. (a, b) -> a
fst) ([(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
sigs [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a. Semigroup a => a -> a -> a
<> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
vals [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a. Semigroup a => a -> a -> a
<> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
tyFamInsts [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
-> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
forall a. Semigroup a => a -> a -> a
<> [(SrcSpan, GenLocated SrcSpanAnnA (HsDecl GhcPs))]
dataFamInsts)
  GenLocated SrcSpanAnnA (HsSigType GhcPs)
-> (HsSigType GhcPs -> R ()) -> R ()
forall l a. HasSrcSpan l => GenLocated l a -> (a -> R ()) -> R ()
located GenLocated SrcSpanAnnA (HsSigType GhcPs)
LHsSigType GhcPs
cid_poly_ty ((HsSigType GhcPs -> R ()) -> R ())
-> (HsSigType GhcPs -> R ()) -> R ()
forall a b. (a -> b) -> a -> b
$ \HsSigType GhcPs
sigTy -> do
    R ()
breakpoint
    R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
      Maybe (LocatedP OverlapMode) -> R () -> R ()
match_overlap_mode Maybe (LocatedP OverlapMode)
Maybe (XRec GhcPs OverlapMode)
cid_overlap_mode R ()
breakpoint
      HsSigType GhcPs -> R ()
p_hsSigType HsSigType GhcPs
sigTy
      Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
allDecls) (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
        R ()
breakpoint
        Text -> R ()
txt Text
"where"
  Bool -> R () -> R ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([GenLocated SrcSpanAnnA (HsDecl GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
allDecls) (R () -> R ()) -> (R () -> R ()) -> R () -> R ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R () -> R ()
inci (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ do
    -- Ensure whitespace is added after where clause.
    R ()
breakpoint
    R () -> R ()
dontUseBraces (R () -> R ()) -> R () -> R ()
forall a b. (a -> b) -> a -> b
$ FamilyStyle -> [LHsDecl GhcPs] -> R ()
p_hsDeclsRespectGrouping FamilyStyle
Associated [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
[LHsDecl GhcPs]
allDecls

p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()
p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()
p_tyFamInstDecl FamilyStyle
style TyFamInstDecl {TyFamInstEqn GhcPs
XCTyFamInstDecl GhcPs
tfid_xtn :: forall pass. TyFamInstDecl pass -> XCTyFamInstDecl pass
tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
tfid_eqn :: TyFamInstEqn GhcPs
tfid_xtn :: XCTyFamInstDecl GhcPs
..} = do
  Text -> R ()
txt (Text -> R ()) -> Text -> R ()
forall a b. (a -> b) -> a -> b
$ case FamilyStyle
style of
    FamilyStyle
Associated -> Text
"type"
    FamilyStyle
Free -> Text
"type instance"
  R ()
breakpoint
  R () -> R ()
inci (TyFamInstEqn GhcPs -> R ()
p_tyFamInstEqn TyFamInstEqn GhcPs
tfid_eqn)

p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R ()
p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R ()
p_dataFamInstDecl FamilyStyle
style (DataFamInstDecl {dfid_eqn :: forall pass. DataFamInstDecl pass -> FamEqn pass (HsDataDefn pass)
dfid_eqn = FamEqn {HsTyPats GhcPs
HsDataDefn GhcPs
XCFamEqn GhcPs (HsDataDefn GhcPs)
LIdP GhcPs
LexicalFixity
HsOuterFamEqnTyVarBndrs GhcPs
feqn_tycon :: forall pass rhs. FamEqn pass rhs -> LIdP pass
feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
feqn_ext :: forall pass rhs. FamEqn pass rhs -> XCFamEqn pass rhs
feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> HsOuterFamEqnTyVarBndrs pass
feqn_rhs :: HsDataDefn GhcPs
feqn_fixity :: LexicalFixity
feqn_pats :: HsTyPats GhcPs
feqn_bndrs :: HsOuterFamEqnTyVarBndrs GhcPs
feqn_tycon :: LIdP GhcPs
feqn_ext :: XCFamEqn GhcPs (HsDataDefn GhcPs)
..}}) =
  FamilyStyle
-> LocatedN RdrName
-> HsTyPats GhcPs
-> LexicalFixity
-> HsDataDefn GhcPs
-> R ()
p_dataDecl FamilyStyle
style LocatedN RdrName
LIdP GhcPs
feqn_tycon HsTyPats GhcPs
feqn_pats LexicalFixity
feqn_fixity HsDataDefn GhcPs
feqn_rhs

match_overlap_mode :: Maybe (LocatedP OverlapMode) -> R () -> R ()
match_overlap_mode :: Maybe (LocatedP OverlapMode) -> R () -> R ()
match_overlap_mode Maybe (LocatedP OverlapMode)
overlap_mode R ()
layoutStrategy =
  case LocatedP OverlapMode -> OverlapMode
forall l e. GenLocated l e -> e
unLoc (LocatedP OverlapMode -> OverlapMode)
-> Maybe (LocatedP OverlapMode) -> Maybe OverlapMode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LocatedP OverlapMode)
overlap_mode of
    Just Overlappable {} -> do
      Text -> R ()
txt Text
"{-# OVERLAPPABLE #-}"
      R ()
layoutStrategy
    Just Overlapping {} -> do
      Text -> R ()
txt Text
"{-# OVERLAPPING #-}"
      R ()
layoutStrategy
    Just Overlaps {} -> do
      Text -> R ()
txt Text
"{-# OVERLAPS #-}"
      R ()
layoutStrategy
    Just Incoherent {} -> do
      Text -> R ()
txt Text
"{-# INCOHERENT #-}"
      R ()
layoutStrategy
    Maybe OverlapMode
_ -> () -> R ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()