    {-# 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 BasicTypes
    import Control.Arrow
    import Control.Monad
    import Data.Foldable
    import Data.List (sortOn)
    import GHC
    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
    import Ormolu.Utils

    p_standaloneDerivDecl :: DerivDecl GhcPs -> R ()
    p_standaloneDerivDecl :: DerivDecl GhcPs -> R ()
    p_standaloneDerivDecl DerivDecl {..} = do
      let typesAfterInstance :: R ()
    typesAfterInstance = Located (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located (HsImplicitBndrs GhcPs (Located (HsType GhcPs))
    -> Located (HsType GhcPs)
    forall pass thing. HsImplicitBndrs pass thing -> thing
    hsib_body (LHsSigWcType GhcPs
    -> HsImplicitBndrs GhcPs (Located (HsType GhcPs))
    forall pass thing. HsWildCardBndrs pass thing -> thing
    hswc_body LHsSigWcType GhcPs
    deriv_type)) HsType GhcPs -> R ()
    p_hsType
          instTypes :: Bool -> R ()
    instTypes toIndent :: Bool
    toIndent = R () -> R ()
    inci (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
            Text -> R ()
    txt "instance"
            R ()
    breakpoint
            Maybe (Located OverlapMode) -> R () -> R ()
    match_overlap_mode Maybe (Located OverlapMode)
    deriv_overlap_mode R ()
    breakpoint
            Bool -> R () -> R ()
    inciIf Bool
    toIndent R ()
    typesAfterInstance
      Text -> R ()
    txt "deriving"
      R ()
    space
      case Maybe (LDerivStrategy GhcPs)
    deriv_strategy of
        Nothing ->
          Bool -> R ()
    instTypes Bool
    False
        Just (L _ a :: DerivStrategy GhcPs
    a) -> case DerivStrategy GhcPs
    a of
          StockStrategy -> do
            Text -> R ()
    txt "stock "
            Bool -> R ()
    instTypes Bool
    False
          AnyclassStrategy -> do
            Text -> R ()
    txt "anyclass "
            Bool -> R ()
    instTypes Bool
    False
          NewtypeStrategy -> do
            Text -> R ()
    txt "newtype "
            Bool -> R ()
    instTypes Bool
    False
          ViaStrategy HsIB {..} -> do
            Text -> R ()
    txt "via"
            R ()
    breakpoint
            R () -> R ()
    inci (Located (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located Located (HsType GhcPs)
    hsib_body HsType GhcPs -> R ()
    p_hsType)
            R ()
    breakpoint
            Bool -> R ()
    instTypes Bool
    True
          ViaStrategy (XHsImplicitBndrs x) ->
            NoExtCon -> R ()
    forall a. NoExtCon -> a
    noExtCon NoExtCon
    XXHsImplicitBndrs GhcPs (Located (HsType GhcPs))
    x
    p_standaloneDerivDecl (XDerivDecl _) = String -> R ()
    forall a. String -> a
    notImplemented "XDerivDecl"

    p_clsInstDecl :: ClsInstDecl GhcPs -> R ()
    p_clsInstDecl :: ClsInstDecl GhcPs -> R ()
    p_clsInstDecl = \case
      ClsInstDecl {..} -> do
        Text -> R ()
    txt "instance"
        case HsImplicitBndrs GhcPs (Located (HsType GhcPs))
    cid_poly_ty of
          HsIB {..} -> do
            -- 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 SrcSpan (HsDecl GhcPs))]
    sigs = (LSig GhcPs -> SrcSpan
    forall a. HasSrcSpan a => a -> SrcSpan
    getLoc (LSig GhcPs -> SrcSpan)
    -> (LSig GhcPs -> GenLocated SrcSpan (HsDecl GhcPs))
    -> LSig GhcPs
    -> (SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& (Sig GhcPs -> HsDecl GhcPs)
    -> LSig GhcPs -> GenLocated SrcSpan (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)) (LSig GhcPs -> (SrcSpan, GenLocated SrcSpan (HsDecl GhcPs)))
    -> [LSig GhcPs] -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [LSig GhcPs]
    cid_sigs
                vals :: [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    vals = (GenLocated SrcSpan (HsBind GhcPs) -> SrcSpan
    forall a. HasSrcSpan a => a -> SrcSpan
    getLoc (GenLocated SrcSpan (HsBind GhcPs) -> SrcSpan)
    -> (GenLocated SrcSpan (HsBind GhcPs)
        -> GenLocated SrcSpan (HsDecl GhcPs))
    -> GenLocated SrcSpan (HsBind GhcPs)
    -> (SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& (HsBind GhcPs -> HsDecl GhcPs)
    -> GenLocated SrcSpan (HsBind GhcPs)
    -> GenLocated SrcSpan (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 SrcSpan (HsBind GhcPs)
     -> (SrcSpan, GenLocated SrcSpan (HsDecl GhcPs)))
    -> [GenLocated SrcSpan (HsBind GhcPs)]
    -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> LHsBinds GhcPs -> [GenLocated SrcSpan (HsBind GhcPs)]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList LHsBinds GhcPs
    cid_binds
                tyFamInsts :: [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    tyFamInsts =
                  ( LTyFamInstDecl GhcPs -> SrcSpan
    forall a. HasSrcSpan a => a -> SrcSpan
    getLoc (LTyFamInstDecl GhcPs -> SrcSpan)
    -> (LTyFamInstDecl GhcPs -> GenLocated SrcSpan (HsDecl GhcPs))
    -> LTyFamInstDecl GhcPs
    -> (SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& (TyFamInstDecl GhcPs -> HsDecl GhcPs)
    -> LTyFamInstDecl GhcPs -> GenLocated SrcSpan (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)
                  )
                    (LTyFamInstDecl GhcPs
     -> (SrcSpan, GenLocated SrcSpan (HsDecl GhcPs)))
    -> [LTyFamInstDecl GhcPs]
    -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [LTyFamInstDecl GhcPs]
    cid_tyfam_insts
                dataFamInsts :: [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    dataFamInsts =
                  ( LDataFamInstDecl GhcPs -> SrcSpan
    forall a. HasSrcSpan a => a -> SrcSpan
    getLoc (LDataFamInstDecl GhcPs -> SrcSpan)
    -> (LDataFamInstDecl GhcPs -> GenLocated SrcSpan (HsDecl GhcPs))
    -> LDataFamInstDecl GhcPs
    -> (SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& (DataFamInstDecl GhcPs -> HsDecl GhcPs)
    -> LDataFamInstDecl GhcPs -> GenLocated SrcSpan (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 NoExtField
    XDataFamInstD GhcPs
    NoExtField)
                  )
                    (LDataFamInstDecl GhcPs
     -> (SrcSpan, GenLocated SrcSpan (HsDecl GhcPs)))
    -> [LDataFamInstDecl GhcPs]
    -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [LDataFamInstDecl GhcPs]
    cid_datafam_insts
                allDecls :: [GenLocated SrcSpan (HsDecl GhcPs)]
    allDecls =
                  (SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))
    -> GenLocated SrcSpan (HsDecl GhcPs)
    forall a b. (a, b) -> b
    snd ((SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))
     -> GenLocated SrcSpan (HsDecl GhcPs))
    -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    -> [GenLocated SrcSpan (HsDecl GhcPs)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((SrcSpan, GenLocated SrcSpan (HsDecl GhcPs)) -> SrcSpan)
    -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn (SrcSpan, GenLocated SrcSpan (HsDecl GhcPs)) -> SrcSpan
    forall a b. (a, b) -> a
    fst ([(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    sigs [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    forall a. Semigroup a => a -> a -> a
    <> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    vals [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    forall a. Semigroup a => a -> a -> a
    <> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    tyFamInsts [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    -> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    forall a. Semigroup a => a -> a -> a
    <> [(SrcSpan, GenLocated SrcSpan (HsDecl GhcPs))]
    dataFamInsts)
            Located (HsType GhcPs) -> (HsType GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located Located (HsType GhcPs)
    hsib_body ((HsType GhcPs -> R ()) -> R ()) -> (HsType GhcPs -> R ()) -> R ()
    forall a b. (a -> b) -> a -> b
    $ \x :: HsType GhcPs
    x -> do
              R ()
    breakpoint
              R () -> R ()
    inci (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
                Maybe (Located OverlapMode) -> R () -> R ()
    match_overlap_mode Maybe (Located OverlapMode)
    cid_overlap_mode R ()
    breakpoint
                HsType GhcPs -> R ()
    p_hsType HsType GhcPs
    x
                Bool -> R () -> R ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([GenLocated SrcSpan (HsDecl GhcPs)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenLocated SrcSpan (HsDecl GhcPs)]
    allDecls) (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
                  R ()
    breakpoint
                  Text -> R ()
    txt "where"
            Bool -> R () -> R ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([GenLocated SrcSpan (HsDecl GhcPs)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenLocated SrcSpan (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 -> [GenLocated SrcSpan (HsDecl GhcPs)] -> R ()
    p_hsDeclsRespectGrouping FamilyStyle
    Associated [GenLocated SrcSpan (HsDecl GhcPs)]
    allDecls
          XHsImplicitBndrs x :: XXHsImplicitBndrs GhcPs (Located (HsType GhcPs))
    x -> NoExtCon -> R ()
    forall a. NoExtCon -> a
    noExtCon NoExtCon
    XXHsImplicitBndrs GhcPs (Located (HsType GhcPs))
    x
      XClsInstDecl x :: XXClsInstDecl GhcPs
    x -> NoExtCon -> R ()
    forall a. NoExtCon -> a
    noExtCon NoExtCon
    XXClsInstDecl GhcPs
    x

    p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()
    p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()
    p_tyFamInstDecl style :: FamilyStyle
    style = \case
      TyFamInstDecl {..} -> do
        Text -> R ()
    txt (Text -> R ()) -> Text -> R ()
    forall a b. (a -> b) -> a -> b
    $ case FamilyStyle
    style of
          Associated -> "type"
          Free -> "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 style :: FamilyStyle
    style = \case
      DataFamInstDecl {dfid_eqn :: forall pass.
    DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
    dfid_eqn = HsIB {hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
    hsib_body = FamEqn {..}}} ->
        FamilyStyle
    -> Located RdrName
    -> [Located (HsType GhcPs)]
    -> LexicalFixity
    -> HsDataDefn GhcPs
    -> R ()
    p_dataDecl FamilyStyle
    style Located (IdP GhcPs)
    Located RdrName
    feqn_tycon ((LHsTypeArg GhcPs -> Located (HsType GhcPs))
    -> HsTyPats GhcPs -> [Located (HsType GhcPs)]
    forall a b. (a -> b) -> [a] -> [b]
    map LHsTypeArg GhcPs -> Located (HsType GhcPs)
    forall p. LHsTypeArg p -> LHsType p
    typeArgToType HsTyPats GhcPs
    feqn_pats) LexicalFixity
    feqn_fixity HsDataDefn GhcPs
    feqn_rhs
      DataFamInstDecl {dfid_eqn :: forall pass.
    DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
    dfid_eqn = HsIB {hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
    hsib_body = XFamEqn {}}} ->
        String -> R ()
    forall a. String -> a
    notImplemented "XFamEqn"
      DataFamInstDecl {dfid_eqn :: forall pass.
    DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
    dfid_eqn = XHsImplicitBndrs {}} ->
        String -> R ()
    forall a. String -> a
    notImplemented "XHsImplicitBndrs"

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