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

    -- | Rendering of data\/type families.
    module Ormolu.Printer.Meat.Declaration.TypeFamily
      ( p_famDecl,
        p_tyFamInstEqn,
      )
    where

    import Control.Monad
    import Data.Maybe (isNothing)
    import GHC
    import Ormolu.Printer.Combinators
    import Ormolu.Printer.Meat.Common
    import Ormolu.Printer.Meat.Type
    import Ormolu.Utils

    p_famDecl :: FamilyStyle -> FamilyDecl GhcPs -> R ()
    p_famDecl :: FamilyStyle -> FamilyDecl GhcPs -> R ()
    p_famDecl style :: FamilyStyle
    style FamilyDecl {fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
    fdTyVars = HsQTvs {..}, ..} = do
      Maybe (Maybe [LTyFamInstEqn GhcPs])
    mmeqs <- case FamilyInfo GhcPs
    fdInfo of
        DataFamily -> Maybe (Maybe [LTyFamInstEqn GhcPs])
    forall a. Maybe a
    Nothing Maybe (Maybe [LTyFamInstEqn GhcPs])
    -> R () -> R (Maybe (Maybe [LTyFamInstEqn GhcPs]))
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Text -> R ()
    txt "data"
        OpenTypeFamily -> Maybe (Maybe [LTyFamInstEqn GhcPs])
    forall a. Maybe a
    Nothing Maybe (Maybe [LTyFamInstEqn GhcPs])
    -> R () -> R (Maybe (Maybe [LTyFamInstEqn GhcPs]))
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Text -> R ()
    txt "type"
        ClosedTypeFamily eqs :: Maybe [LTyFamInstEqn GhcPs]
    eqs -> Maybe [LTyFamInstEqn GhcPs] -> Maybe (Maybe [LTyFamInstEqn GhcPs])
    forall a. a -> Maybe a
    Just Maybe [LTyFamInstEqn GhcPs]
    eqs Maybe (Maybe [LTyFamInstEqn GhcPs])
    -> R () -> R (Maybe (Maybe [LTyFamInstEqn GhcPs]))
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Text -> R ()
    txt "type"
      Text -> R ()
    txt (Text -> R ()) -> Text -> R ()
    forall a b. (a -> b) -> a -> b
    $ case FamilyStyle
    style of
        Associated -> Text
    forall a. Monoid a => a
    mempty
        Free -> " family"
      R ()
    breakpoint
      R () -> R ()
    inci (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
        [SrcSpan] -> R () -> R ()
    switchLayout (Located RdrName -> SrcSpan
    forall a. HasSrcSpan a => a -> SrcSpan
    getLoc Located (IdP GhcPs)
    Located RdrName
    fdLName SrcSpan -> [SrcSpan] -> [SrcSpan]
    forall a. a -> [a] -> [a]
    : (LHsTyVarBndr GhcPs -> SrcSpan
    forall a. HasSrcSpan a => a -> SrcSpan
    getLoc (LHsTyVarBndr GhcPs -> SrcSpan)
    -> [LHsTyVarBndr GhcPs] -> [SrcSpan]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [LHsTyVarBndr GhcPs]
    hsq_explicit)) (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $
          Bool -> Bool -> R () -> [R ()] -> R ()
    p_infixDefHelper
            (LexicalFixity -> Bool
    isInfix LexicalFixity
    fdFixity)
            Bool
    True
            (Located RdrName -> R ()
    p_rdrName Located (IdP GhcPs)
    Located RdrName
    fdLName)
            ((HsTyVarBndr GhcPs -> R ()) -> LHsTyVarBndr GhcPs -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' HsTyVarBndr GhcPs -> R ()
    p_hsTyVarBndr (LHsTyVarBndr GhcPs -> R ()) -> [LHsTyVarBndr GhcPs] -> [R ()]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [LHsTyVarBndr GhcPs]
    hsq_explicit)
        let resultSig :: Maybe (R ())
    resultSig = LFamilyResultSig GhcPs -> Maybe (R ())
    p_familyResultSigL LFamilyResultSig GhcPs
    fdResultSig
        Bool -> R () -> R ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Maybe (R ()) -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe (R ())
    resultSig Bool -> Bool -> Bool
    && Maybe (LInjectivityAnn GhcPs) -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe (LInjectivityAnn GhcPs)
    fdInjectivityAnn) R ()
    space
        R () -> R ()
    inci (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
          Maybe (R ()) -> R ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ Maybe (R ())
    resultSig
          R ()
    space
          Maybe (LInjectivityAnn GhcPs)
    -> (LInjectivityAnn GhcPs -> R ()) -> R ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ Maybe (LInjectivityAnn GhcPs)
    fdInjectivityAnn ((InjectivityAnn GhcPs -> R ()) -> LInjectivityAnn GhcPs -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' InjectivityAnn GhcPs -> R ()
    p_injectivityAnn)
      case Maybe (Maybe [LTyFamInstEqn GhcPs])
    mmeqs of
        Nothing -> () -> R ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Just meqs :: Maybe [LTyFamInstEqn GhcPs]
    meqs -> do
          R () -> R ()
    inci (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
            R ()
    breakpoint
            Text -> R ()
    txt "where"
          case Maybe [LTyFamInstEqn GhcPs]
    meqs of
            Nothing -> do
              R ()
    space
              Text -> R ()
    txt ".."
            Just eqs :: [LTyFamInstEqn GhcPs]
    eqs -> do
              R ()
    newline
              R ()
    -> (LTyFamInstEqn GhcPs -> R ()) -> [LTyFamInstEqn GhcPs] -> R ()
    forall a. R () -> (a -> R ()) -> [a] -> R ()
    sep R ()
    newline ((TyFamInstEqn GhcPs -> R ()) -> LTyFamInstEqn GhcPs -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' (R () -> R ()
    inci (R () -> R ())
    -> (TyFamInstEqn GhcPs -> R ()) -> TyFamInstEqn GhcPs -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyFamInstEqn GhcPs -> R ()
    p_tyFamInstEqn)) [LTyFamInstEqn GhcPs]
    eqs
    p_famDecl _ FamilyDecl {fdTyVars :: forall pass. FamilyDecl pass -> LHsQTyVars pass
    fdTyVars = XLHsQTyVars {}} =
      String -> R ()
    forall a. String -> a
    notImplemented "XLHsQTyVars"
    p_famDecl _ (XFamilyDecl x :: XXFamilyDecl GhcPs
    x) = NoExtCon -> R ()
    forall a. NoExtCon -> a
    noExtCon NoExtCon
    XXFamilyDecl GhcPs
    x

    p_familyResultSigL ::
      Located (FamilyResultSig GhcPs) ->
      Maybe (R ())
    p_familyResultSigL :: LFamilyResultSig GhcPs -> Maybe (R ())
    p_familyResultSigL l :: LFamilyResultSig GhcPs
    l =
      case LFamilyResultSig GhcPs
    l of
        L _ a :: FamilyResultSig GhcPs
    a -> case FamilyResultSig GhcPs
    a of
          NoSig NoExtField -> Maybe (R ())
    forall a. Maybe a
    Nothing
          KindSig NoExtField k :: LHsKind GhcPs
    k -> R () -> Maybe (R ())
    forall a. a -> Maybe a
    Just (R () -> Maybe (R ())) -> R () -> Maybe (R ())
    forall a b. (a -> b) -> a -> b
    $ do
            Text -> R ()
    txt "::"
            R ()
    breakpoint
            LHsKind GhcPs -> (HsKind GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsKind GhcPs
    k HsKind GhcPs -> R ()
    p_hsType
          TyVarSig NoExtField bndr :: LHsTyVarBndr GhcPs
    bndr -> R () -> Maybe (R ())
    forall a. a -> Maybe a
    Just (R () -> Maybe (R ())) -> R () -> Maybe (R ())
    forall a b. (a -> b) -> a -> b
    $ do
            R ()
    equals
            R ()
    breakpoint
            LHsTyVarBndr GhcPs -> (HsTyVarBndr GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsTyVarBndr GhcPs
    bndr HsTyVarBndr GhcPs -> R ()
    p_hsTyVarBndr
          XFamilyResultSig x :: XXFamilyResultSig GhcPs
    x ->
            NoExtCon -> Maybe (R ())
    forall a. NoExtCon -> a
    noExtCon NoExtCon
    XXFamilyResultSig GhcPs
    x

    p_injectivityAnn :: InjectivityAnn GhcPs -> R ()
    p_injectivityAnn :: InjectivityAnn GhcPs -> R ()
    p_injectivityAnn (InjectivityAnn a :: Located (IdP GhcPs)
    a bs :: [Located (IdP GhcPs)]
    bs) = do
      Text -> R ()
    txt "|"
      R ()
    space
      Located RdrName -> R ()
    p_rdrName Located (IdP GhcPs)
    Located RdrName
    a
      R ()
    space
      Text -> R ()
    txt "->"
      R ()
    space
      R () -> (Located RdrName -> R ()) -> [Located RdrName] -> R ()
    forall a. R () -> (a -> R ()) -> [a] -> R ()
    sep R ()
    space Located RdrName -> R ()
    p_rdrName [Located (IdP GhcPs)]
    [Located RdrName]
    bs

    p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()
    p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()
    p_tyFamInstEqn HsIB {hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
    hsib_body = FamEqn {..}} = do
      case Maybe [LHsTyVarBndr GhcPs]
    feqn_bndrs of
        Nothing -> () -> R ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        Just bndrs :: [LHsTyVarBndr GhcPs]
    bndrs -> do
          ForallVisFlag
    -> (HsTyVarBndr GhcPs -> R ()) -> [LHsTyVarBndr GhcPs] -> R ()
    forall a.
    Data a =>
    ForallVisFlag -> (a -> R ()) -> [Located a] -> R ()
    p_forallBndrs ForallVisFlag
    ForallInvis HsTyVarBndr GhcPs -> R ()
    p_hsTyVarBndr [LHsTyVarBndr GhcPs]
    bndrs
          R ()
    breakpoint
      Bool -> R () -> R ()
    inciIf (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Maybe [LHsTyVarBndr GhcPs] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null Maybe [LHsTyVarBndr GhcPs]
    feqn_bndrs) (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $ do
        let famLhsSpn :: [SrcSpan]
    famLhsSpn = Located RdrName -> SrcSpan
    forall a. HasSrcSpan a => a -> SrcSpan
    getLoc Located (IdP GhcPs)
    Located RdrName
    feqn_tycon SrcSpan -> [SrcSpan] -> [SrcSpan]
    forall a. a -> [a] -> [a]
    : (LHsTypeArg GhcPs -> SrcSpan) -> HsTyPats GhcPs -> [SrcSpan]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (LHsKind GhcPs -> SrcSpan
    forall a. HasSrcSpan a => a -> SrcSpan
    getLoc (LHsKind GhcPs -> SrcSpan)
    -> (LHsTypeArg GhcPs -> LHsKind GhcPs)
    -> LHsTypeArg GhcPs
    -> SrcSpan
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsTypeArg GhcPs -> LHsKind GhcPs
    forall p. LHsTypeArg p -> LHsType p
    typeArgToType) HsTyPats GhcPs
    feqn_pats
        [SrcSpan] -> R () -> R ()
    switchLayout [SrcSpan]
    famLhsSpn (R () -> R ()) -> R () -> R ()
    forall a b. (a -> b) -> a -> b
    $
          Bool -> Bool -> R () -> [R ()] -> R ()
    p_infixDefHelper
            (LexicalFixity -> Bool
    isInfix LexicalFixity
    feqn_fixity)
            Bool
    True
            (Located RdrName -> R ()
    p_rdrName Located (IdP GhcPs)
    Located RdrName
    feqn_tycon)
            ((HsKind GhcPs -> R ()) -> LHsKind GhcPs -> R ()
    forall a. (a -> R ()) -> Located a -> R ()
    located' HsKind GhcPs -> R ()
    p_hsType (LHsKind GhcPs -> R ())
    -> (LHsTypeArg GhcPs -> LHsKind GhcPs) -> LHsTypeArg GhcPs -> R ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsTypeArg GhcPs -> LHsKind GhcPs
    forall p. LHsTypeArg p -> LHsType p
    typeArgToType (LHsTypeArg GhcPs -> R ()) -> HsTyPats GhcPs -> [R ()]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HsTyPats GhcPs
    feqn_pats)
        R ()
    space
        R ()
    equals
        R ()
    breakpoint
        R () -> R ()
    inci (LHsKind GhcPs -> (HsKind GhcPs -> R ()) -> R ()
    forall a. Located a -> (a -> R ()) -> R ()
    located LHsKind GhcPs
    feqn_rhs HsKind GhcPs -> R ()
    p_hsType)
    p_tyFamInstEqn HsIB {hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
    hsib_body = XFamEqn x :: XXFamEqn GhcPs (LHsKind GhcPs)
    x} = NoExtCon -> R ()
    forall a. NoExtCon -> a
    noExtCon NoExtCon
    XXFamEqn GhcPs (LHsKind GhcPs)
    x
    p_tyFamInstEqn (XHsImplicitBndrs x :: XXHsImplicitBndrs GhcPs (FamEqn GhcPs (LHsKind GhcPs))
    x) = NoExtCon -> R ()
    forall a. NoExtCon -> a
    noExtCon NoExtCon
    XXHsImplicitBndrs GhcPs (FamEqn GhcPs (LHsKind GhcPs))
    x

    ----------------------------------------------------------------------------
    -- Helpers

    isInfix :: LexicalFixity -> Bool
    isInfix :: LexicalFixity -> Bool
    isInfix = \case
      Infix -> Bool
    True
      Prefix -> Bool
    False