content: {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  
  module Language.Haskell.Brittany.Internal.Layouters.Type where
  
  import qualified Data.Text as Text
  import GHC (AnnKeywordId(..), GenLocated(L))
  import GHC.Hs
  import qualified GHC.OldList as List
  import GHC.Types.Basic
  import GHC.Utils.Outputable (ftext, showSDocUnsafe)
  import Language.Haskell.Brittany.Internal.LayouterBasics
  import Language.Haskell.Brittany.Internal.Prelude
  import Language.Haskell.Brittany.Internal.PreludeUtils
  import Language.Haskell.Brittany.Internal.Types
  import Language.Haskell.Brittany.Internal.Utils
    (FirstLastView(..), splitFirstLast)
  
  
  
  layoutType :: ToBriDoc HsType
  layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
    -- _ | traceShow (ExactPrint.Types.mkAnnKey ltype) False -> error "impossible"
    HsTyVar _ promoted name -> do
      t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
      case promoted of
        IsPromoted -> docSeq [docSeparator, docTick, docWrapNode name $ docLit t]
        NotPromoted -> docWrapNode name $ docLit t
    HsForAllTy _ hsf (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
      let bndrs = getBinders hsf
      typeDoc <- docSharedWrapper layoutType typ2
      tyVarDocs <- layoutTyVarBndrs bndrs
      cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
      let
        maybeForceML = case typ2 of
          (L _ HsFunTy{}) -> docForceMultiline
          _ -> id
      let
        tyVarDocLineList = processTyVarBndrsSingleline tyVarDocs
        forallDoc = docAlt
          [ let open = docLit $ Text.pack "forall"
            in docSeq ([open] ++ tyVarDocLineList)
          , docPar
            (docLit (Text.pack "forall"))
            (docLines $ tyVarDocs <&> \case
              (tname, Nothing) -> docEnsureIndent BrIndentRegular $ docLit tname
              (tname, Just doc) -> docEnsureIndent BrIndentRegular $ docLines
                [ docCols ColTyOpPrefix [docParenLSep, docLit tname]
                , docCols ColTyOpPrefix [docLit $ Text.pack ":: ", doc]
                , docLit $ Text.pack ")"
                ]
            )
          ]
        contextDoc = case cntxtDocs of
          [] -> docLit $ Text.pack "()"
          [x] -> x
          _ -> docAlt
            [ let
                open = docLit $ Text.pack "("
                close = docLit $ Text.pack ")"
                list =
                  List.intersperse docCommaSep $ docForceSingleline <$> cntxtDocs
              in docSeq ([open] ++ list ++ [close])
            , let
                open = docCols
                  ColTyOpPrefix
                  [docParenLSep, docAddBaseY (BrIndentSpecial 2) $ head cntxtDocs]
                close = docLit $ Text.pack ")"
                list = List.tail cntxtDocs <&> \cntxtDoc -> docCols
                  ColTyOpPrefix
                  [docCommaSep, docAddBaseY (BrIndentSpecial 2) cntxtDoc]
              in docPar open $ docLines $ list ++ [close]
            ]
      docAlt
        -- :: forall a b c . (Foo a b c) => a b -> c
        [ docSeq
          [ if null bndrs
            then docEmpty
            else
              let
                open = docLit $ Text.pack "forall"
                close = docLit $ Text.pack " . "
              in docSeq ([open, docSeparator] ++ tyVarDocLineList ++ [close])
          , docForceSingleline contextDoc
          , docLit $ Text.pack " => "
          , docForceSingleline typeDoc
          ]
        -- :: forall a b c
        --  . (Foo a b c)
        -- => a b
        -- -> c
        , docPar
          forallDoc
          (docLines
            [ docCols
              ColTyOpPrefix
              [ docWrapNodeRest ltype $ docLit $ Text.pack " . "
              , docAddBaseY (BrIndentSpecial 3) $ contextDoc
              ]
            , docCols
              ColTyOpPrefix
              [ docLit $ Text.pack "=> "
              , docAddBaseY (BrIndentSpecial 3) $ maybeForceML $ typeDoc
              ]
            ]
          )
        ]
    HsForAllTy _ hsf typ2 -> do
      let bndrs = getBinders hsf
      typeDoc <- layoutType typ2
      tyVarDocs <- layoutTyVarBndrs bndrs
      let
        maybeForceML = case typ2 of
          (L _ HsFunTy{}) -> docForceMultiline
          _ -> id
      let tyVarDocLineList = processTyVarBndrsSingleline tyVarDocs
      docAlt
        -- forall x . x
        [ docSeq
          [ if null bndrs
            then docEmpty
            else
              let
                open = docLit $ Text.pack "forall"
                close = docLit $ Text.pack " . "
              in docSeq ([open] ++ tyVarDocLineList ++ [close])
          , docForceSingleline $ return $ typeDoc
          ]
        -- :: forall x
        --  . x
        , docPar
          (docSeq $ docLit (Text.pack "forall") : tyVarDocLineList)
          (docCols
            ColTyOpPrefix
            [ docWrapNodeRest ltype $ docLit $ Text.pack " . "
            , maybeForceML $ return typeDoc
            ]
          )
        -- :: forall
        --      (x :: *)
        --  . x
        , docPar
          (docLit (Text.pack "forall"))
          (docLines
          $ (tyVarDocs <&> \case
              (tname, Nothing) ->
                docEnsureIndent BrIndentRegular $ docLit tname
              (tname, Just doc) -> docEnsureIndent BrIndentRegular $ docLines
                [ docCols ColTyOpPrefix [docParenLSep, docLit tname]
                , docCols ColTyOpPrefix [docLit $ Text.pack ":: ", doc]
                , docLit $ Text.pack ")"
                ]
            )
          ++ [ docCols
                 ColTyOpPrefix
                 [ docWrapNodeRest ltype $ docLit $ Text.pack " . "
                 , maybeForceML $ return typeDoc
                 ]
             ]
          )
        ]
    HsQualTy _ lcntxts@(L _ cntxts) typ1 -> do
      typeDoc <- docSharedWrapper layoutType typ1
      cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
      let
        contextDoc = docWrapNode lcntxts $ case cntxtDocs of
          [] -> docLit $ Text.pack "()"
          [x] -> x
          _ -> docAlt
            [ let
                open = docLit $ Text.pack "("
                close = docLit $ Text.pack ")"
                list =
                  List.intersperse docCommaSep $ docForceSingleline <$> cntxtDocs
              in docSeq ([open] ++ list ++ [close])
            , let
                open = docCols
                  ColTyOpPrefix
                  [docParenLSep, docAddBaseY (BrIndentSpecial 2) $ head cntxtDocs]
                close = docLit $ Text.pack ")"
                list = List.tail cntxtDocs <&> \cntxtDoc -> docCols
                  ColTyOpPrefix
                  [docCommaSep, docAddBaseY (BrIndentSpecial 2) $ cntxtDoc]
              in docPar open $ docLines $ list ++ [close]
            ]
      let
        maybeForceML = case typ1 of
          (L _ HsFunTy{}) -> docForceMultiline
          _ -> id
      docAlt
        -- (Foo a b c) => a b -> c
        [ docSeq
          [ docForceSingleline contextDoc
          , docLit $ Text.pack " => "
          , docForceSingleline typeDoc
          ]
        --    (Foo a b c)
        -- => a b
        -- -> c
        , docPar
          (docForceSingleline contextDoc)
          (docCols
            ColTyOpPrefix
            [ docLit $ Text.pack "=> "
            , docAddBaseY (BrIndentSpecial 3) $ maybeForceML typeDoc
            ]
          )
        ]
    HsFunTy _ _ typ1 typ2 -> do
      typeDoc1 <- docSharedWrapper layoutType typ1
      typeDoc2 <- docSharedWrapper layoutType typ2
      let
        maybeForceML = case typ2 of
          (L _ HsFunTy{}) -> docForceMultiline
          _ -> id
      hasComments <- hasAnyCommentsBelow ltype
      docAlt
        $ [ docSeq
              [ appSep $ docForceSingleline typeDoc1
              , appSep $ docLit $ Text.pack "->"
              , docForceSingleline typeDoc2
              ]
          | not hasComments
          ]
        ++ [ docPar
               (docNodeAnnKW ltype Nothing typeDoc1)
               (docCols
                 ColTyOpPrefix
                 [ docWrapNodeRest ltype $ appSep $ docLit $ Text.pack "->"
                 , docAddBaseY (BrIndentSpecial 3) $ maybeForceML typeDoc2
                 ]
               )
           ]
    HsParTy _ typ1 -> do
      typeDoc1 <- docSharedWrapper layoutType typ1
      docAlt
        [ docSeq
          [ docWrapNodeRest ltype $ docLit $ Text.pack "("
          , docForceSingleline typeDoc1
          , docLit $ Text.pack ")"
          ]
        , docPar
          (docCols
            ColTyOpPrefix
            [ docWrapNodeRest ltype $ docParenLSep
            , docAddBaseY (BrIndentSpecial 2) $ typeDoc1
            ]
          )
          (docLit $ Text.pack ")")
        ]
    HsAppTy _ typ1@(L _ HsAppTy{}) typ2 -> do
      let
        gather
          :: [LHsType GhcPs] -> LHsType GhcPs -> (LHsType GhcPs, [LHsType GhcPs])
        gather list = \case
          L _ (HsAppTy _ ty1 ty2) -> gather (ty2 : list) ty1
          final -> (final, list)
      let (typHead, typRest) = gather [typ2] typ1
      docHead <- docSharedWrapper layoutType typHead
      docRest <- docSharedWrapper layoutType `mapM` typRest
      docAlt
        [ docSeq
        $ docForceSingleline docHead
        : (docRest >>= \d -> [docSeparator, docForceSingleline d])
        , docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest)
        ]
    HsAppTy _ typ1 typ2 -> do
      typeDoc1 <- docSharedWrapper layoutType typ1
      typeDoc2 <- docSharedWrapper layoutType typ2
      docAlt
        [ docSeq
          [docForceSingleline typeDoc1, docSeparator, docForceSingleline typeDoc2]
        , docPar typeDoc1 (docEnsureIndent BrIndentRegular typeDoc2)
        ]
    HsListTy _ typ1 -> do
      typeDoc1 <- docSharedWrapper layoutType typ1
      docAlt
        [ docSeq
          [ docWrapNodeRest ltype $ docLit $ Text.pack "["
          , docForceSingleline typeDoc1
          , docLit $ Text.pack "]"
          ]
        , docPar
          (docCols
            ColTyOpPrefix
            [ docWrapNodeRest ltype $ docLit $ Text.pack "[ "
            , docAddBaseY (BrIndentSpecial 2) $ typeDoc1
            ]
          )
          (docLit $ Text.pack "]")
        ]
    HsTupleTy _ tupleSort typs -> case tupleSort of
      HsUnboxedTuple -> unboxed
      HsBoxedTuple -> simple
      HsConstraintTuple -> simple
      HsBoxedOrConstraintTuple -> simple
     where
      unboxed = if null typs
        then error "brittany internal error: unboxed unit"
        else unboxedL
      simple = if null typs then unitL else simpleL
      unitL = docLit $ Text.pack "()"
      simpleL = do
        docs <- docSharedWrapper layoutType `mapM` typs
        let
          end = docLit $ Text.pack ")"
          lines =
            List.tail docs
              <&> \d -> docAddBaseY (BrIndentSpecial 2)
                    $ docCols ColTyOpPrefix [docCommaSep, d]
          commaDocs = List.intersperse docCommaSep (docForceSingleline <$> docs)
        docAlt
          [ docSeq
          $ [docLit $ Text.pack "("]
          ++ docWrapNodeRest ltype commaDocs
          ++ [end]
          , let line1 = docCols ColTyOpPrefix [docParenLSep, head docs]
            in
              docPar
                (docAddBaseY (BrIndentSpecial 2) $ line1)
                (docLines $ docWrapNodeRest ltype lines ++ [end])
          ]
      unboxedL = do
        docs <- docSharedWrapper layoutType `mapM` typs
        let
          start = docParenHashLSep
          end = docParenHashRSep
        docAlt
          [ docSeq
          $ [start]
          ++ docWrapNodeRest ltype (List.intersperse docCommaSep docs)
          ++ [end]
          , let
              line1 = docCols ColTyOpPrefix [start, head docs]
              lines =
                List.tail docs
                  <&> \d -> docAddBaseY (BrIndentSpecial 2)
                        $ docCols ColTyOpPrefix [docCommaSep, d]
            in docPar
              (docAddBaseY (BrIndentSpecial 2) line1)
              (docLines $ lines ++ [end])
          ]
    HsOpTy{} -> -- TODO
      briDocByExactInlineOnly "HsOpTy{}" ltype
    -- HsOpTy typ1 opName typ2 -> do
    --   -- TODO: these need some proper fixing. precedences don't add up.
    --   --       maybe the parser just returns some trivial right recursion
    --   --       parse result for any type level operators.
    --   --       need to check how things are handled on the expression level.
    --   let opStr = lrdrNameToText opName
    --   let opLen = Text.length opStr
    --   layouter1@(Layouter desc1 _ _) <- layoutType typ1
    --   layouter2@(Layouter desc2 _ _) <- layoutType typ2
    --   let line = do -- Maybe
    --         l1 <- _ldesc_line desc1
    --         l2 <- _ldesc_line desc2
    --         let len1 = _lColumns_min l1
    --         let len2 = _lColumns_min l2
    --         let len = 2 + opLen + len1 + len2
    --         return $ LayoutColumns
    --           { _lColumns_key = ColumnKeyUnique
    --           , _lColumns_lengths = [len]
    --           , _lColumns_min = len
    --           }
    --   let block = do -- Maybe
    --         rol1 <- descToBlockStart desc1
    --         (min2, max2) <- descToMinMax (1+opLen) desc2
    --         let (minR, maxR) = case descToBlockMinMax desc1 of
    --               Nothing -> (min2, max2)
    --               Just (min1, max1) -> (max min1 min2, max max1 max2)
    --         return $ BlockDesc
    --           { _bdesc_blockStart = rol1
    --           , _bdesc_min = minR
    --           , _bdesc_max = maxR
    --           , _bdesc_opIndentFloatUp = Just (1+opLen)
    --           }
    --   return $ Layouter
    --     { _layouter_desc = LayoutDesc
    --       { _ldesc_line = line
    --       , _ldesc_block = block
    --       }
    --     , _layouter_func = \params -> do
    --         remaining <- getCurRemaining
    --         let allowSameLine = _params_sepLines params /= SepLineTypeOp
    --         case line of
    --           Just (LayoutColumns _ _ m) | m <= remaining && allowSameLine -> do
    --             applyLayouterRestore layouter1 defaultParams
    --             layoutWriteAppend $ Text.pack " " <> opStr <> Text.pack " "
    --             applyLayouterRestore layouter2 defaultParams
    --           _ -> do
    --             let upIndent   = maybe (1+opLen) (max (1+opLen)) $ _params_opIndent params
    --             let downIndent = maybe upIndent (max upIndent) $ _bdesc_opIndentFloatUp =<< _ldesc_block desc2
    --             layoutWithAddIndentN downIndent $ applyLayouterRestore layouter1 defaultParams
    --             layoutWriteNewline
    --             layoutWriteAppend $ opStr <> Text.pack " "
    --             layoutWriteEnsureBlockPlusN downIndent
    --             applyLayouterRestore layouter2 defaultParams
    --               { _params_sepLines = SepLineTypeOp
    --               , _params_opIndent = Just downIndent
    --               }
    --     , _layouter_ast = ltype
    --     }
    HsIParamTy _ (L _ (HsIPName ipName)) typ1 -> do
      typeDoc1 <- docSharedWrapper layoutType typ1
      docAlt
        [ docSeq
          [ docWrapNodeRest ltype $ docLit $ Text.pack
            ("?" ++ showSDocUnsafe (ftext ipName) ++ "::")
          , docForceSingleline typeDoc1
          ]
        , docPar
          (docLit $ Text.pack ("?" ++ showSDocUnsafe (ftext ipName)))
          (docCols
            ColTyOpPrefix
            [ docWrapNodeRest ltype $ docLit $ Text.pack ":: "
            , docAddBaseY (BrIndentSpecial 2) typeDoc1
            ]
          )
        ]
    -- TODO: test KindSig
    HsKindSig _ typ1 kind1 -> do
      typeDoc1 <- docSharedWrapper layoutType typ1
      kindDoc1 <- docSharedWrapper layoutType kind1
      hasParens <- hasAnnKeyword ltype AnnOpenP
      docAlt
        [ if hasParens
          then docSeq
            [ docLit $ Text.pack "("
            , docForceSingleline typeDoc1
            , docSeparator
            , docLit $ Text.pack "::"
            , docSeparator
            , docForceSingleline kindDoc1
            , docLit $ Text.pack ")"
            ]
          else docSeq
            [ docForceSingleline typeDoc1
            , docSeparator
            , docLit $ Text.pack "::"
            , docSeparator
            , docForceSingleline kindDoc1
            ]
        , if hasParens
          then docLines
            [ docCols
              ColTyOpPrefix
              [ docWrapNodeRest ltype $ docParenLSep
              , docAddBaseY (BrIndentSpecial 3) $ typeDoc1
              ]
            , docCols
              ColTyOpPrefix
              [ docWrapNodeRest ltype $ docLit $ Text.pack ":: "
              , docAddBaseY (BrIndentSpecial 3) kindDoc1
              ]
            , (docLit $ Text.pack ")")
            ]
          else docPar
            typeDoc1
            (docCols
              ColTyOpPrefix
              [ docWrapNodeRest ltype $ docLit $ Text.pack ":: "
              , docAddBaseY (BrIndentSpecial 3) kindDoc1
              ]
            )
        ]
    HsBangTy{} -> -- TODO
      briDocByExactInlineOnly "HsBangTy{}" ltype
    -- HsBangTy bang typ1 -> do
    --   let bangStr = case bang of
    --         HsSrcBang _ unpackness strictness ->
    --           (++)
    --             (case unpackness of
    --               SrcUnpack   -> "{-# UNPACK -#} "
    --               SrcNoUnpack -> "{-# NOUNPACK -#} "
    --               NoSrcUnpack -> ""
    --             )
    --             (case strictness of
    --               SrcLazy     -> "~"
    --               SrcStrict   -> "!"
    --               NoSrcStrict -> ""
    --             )
    --   let bangLen = length bangStr
    --   layouter@(Layouter desc _ _) <- layoutType typ1
    --   let line = do -- Maybe
    --         l <- _ldesc_line desc
    --         let len = bangLen + _lColumns_min l
    --         return $ LayoutColumns
    --           { _lColumns_key = ColumnKeyUnique
    --           , _lColumns_lengths = [len]
    --           , _lColumns_min = len
    --           }
    --   let block = do -- Maybe
    --         rol <- descToBlockStart desc
    --         (minR,maxR) <- descToBlockMinMax desc
    --         return $ BlockDesc
    --           { _bdesc_blockStart = rol
    --           , _bdesc_min = minR
    --           , _bdesc_max = maxR
    --           , _bdesc_opIndentFloatUp = Nothing
    --           }
    --   return $ Layouter
    --     { _layouter_desc = LayoutDesc
    --       { _ldesc_line = line
    --       , _ldesc_block = block
    --       }
    --     , _layouter_func = \_params -> do
    --         remaining <- getCurRemaining
    --         case line of
    --           Just (LayoutColumns _ _ m) | m <= remaining -> do
    --             layoutWriteAppend $ Text.pack $ bangStr
    --             applyLayouterRestore layouter defaultParams
    --           _ -> do
    --             layoutWriteAppend $ Text.pack $ bangStr
    --             layoutWritePostCommentsRestore ltype
    --             applyLayouterRestore layouter defaultParams
    --     , _layouter_ast = ltype
    --     }
    HsSpliceTy{} -> -- TODO
      briDocByExactInlineOnly "HsSpliceTy{}" ltype
    HsDocTy{} -> -- TODO
      briDocByExactInlineOnly "HsDocTy{}" ltype
    HsRecTy{} -> -- TODO
      briDocByExactInlineOnly "HsRecTy{}" ltype
    HsExplicitListTy _ _ typs -> do
      typDocs <- docSharedWrapper layoutType `mapM` typs
      hasComments <- hasAnyCommentsBelow ltype
      let specialCommaSep = appSep $ docLit $ Text.pack " ,"
      docAlt
        [ docSeq
        $ [docLit $ Text.pack "'["]
        ++ List.intersperse specialCommaSep (docForceSingleline <$> typDocs)
        ++ [docLit $ Text.pack "]"]
        , case splitFirstLast typDocs of
          FirstLastEmpty -> docSeq
            [ docLit $ Text.pack "'["
            , docNodeAnnKW ltype (Just AnnOpenS) $ docLit $ Text.pack "]"
            ]
          FirstLastSingleton e -> docAlt
            [ docSeq
              [ docLit $ Text.pack "'["
              , docNodeAnnKW ltype (Just AnnOpenS) $ docForceSingleline e
              , docLit $ Text.pack "]"
              ]
            , docSetBaseY $ docLines
              [ docSeq
                [ docLit $ Text.pack "'["
                , docSeparator
                , docSetBaseY $ docNodeAnnKW ltype (Just AnnOpenS) e
                ]
              , docLit $ Text.pack " ]"
              ]
            ]
          FirstLast e1 ems eN -> runFilteredAlternative $ do
            addAlternativeCond (not hasComments)
              $ docSeq
              $ [docLit $ Text.pack "'["]
              ++ List.intersperse
                   specialCommaSep
                   (docForceSingleline
                   <$> (e1 : ems ++ [docNodeAnnKW ltype (Just AnnOpenS) eN])
                   )
              ++ [docLit $ Text.pack " ]"]
            addAlternative
              $ let
                  start = docCols ColList [appSep $ docLit $ Text.pack "'[", e1]
                  linesM = ems <&> \d -> docCols ColList [specialCommaSep, d]
                  lineN = docCols
                    ColList
                    [specialCommaSep, docNodeAnnKW ltype (Just AnnOpenS) eN]
                  end = docLit $ Text.pack " ]"
                in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end]
        ]
    HsExplicitTupleTy{} -> -- TODO
      briDocByExactInlineOnly "HsExplicitTupleTy{}" ltype
    HsTyLit _ lit -> case lit of
      HsNumTy (SourceText srctext) _ -> docLit $ Text.pack srctext
      HsNumTy NoSourceText _ ->
        error "overLitValBriDoc: literal with no SourceText"
      HsStrTy (SourceText srctext) _ -> docLit $ Text.pack srctext
      HsStrTy NoSourceText _ ->
        error "overLitValBriDoc: literal with no SourceText"
    HsWildCardTy _ -> docLit $ Text.pack "_"
    HsSumTy{} -> -- TODO
      briDocByExactInlineOnly "HsSumTy{}" ltype
    HsStarTy _ isUnicode -> do
      if isUnicode
        then docLit $ Text.pack "\x2605" -- Unicode star
        else docLit $ Text.pack "*"
    XHsType{} -> error "brittany internal error: XHsType"
    HsAppKindTy _ ty kind -> do
      t <- docSharedWrapper layoutType ty
      k <- docSharedWrapper layoutType kind
      docAlt
        [ docSeq
          [ docForceSingleline t
          , docSeparator
          , docLit $ Text.pack "@"
          , docForceSingleline k
          ]
        , docPar t (docSeq [docLit $ Text.pack "@", k])
        ]
  
  layoutTyVarBndrs
    :: [LHsTyVarBndr () GhcPs]
    -> ToBriDocM [(Text, Maybe (ToBriDocM BriDocNumbered))]
  layoutTyVarBndrs = mapM $ \case
    (L _ (UserTyVar _ _ name)) -> return $ (lrdrNameToText name, Nothing)
    (L _ (KindedTyVar _ _ lrdrName kind)) -> do
      d <- docSharedWrapper layoutType kind
      return $ (lrdrNameToText lrdrName, Just $ d)
  
  -- there is no specific reason this returns a list instead of a single
  -- BriDoc node.
  processTyVarBndrsSingleline
    :: [(Text, Maybe (ToBriDocM BriDocNumbered))] -> [ToBriDocM BriDocNumbered]
  processTyVarBndrsSingleline bndrDocs = bndrDocs >>= \case
    (tname, Nothing) -> [docSeparator, docLit tname]
    (tname, Just doc) ->
      [ docSeparator
      , docLit $ Text.pack "(" <> tname <> Text.pack " :: "
      , docForceSingleline $ doc
      , docLit $ Text.pack ")"
      ]
  
  getBinders :: HsForAllTelescope pass -> [LHsTyVarBndr () pass]
  getBinders x = case x of
    HsForAllVis _ b -> b
    HsForAllInvis _ b -> fmap withoutSpecificity b
    XHsForAllTelescope _ -> []
  
  withoutSpecificity :: LHsTyVarBndr flag pass -> LHsTyVarBndr () pass
  withoutSpecificity = fmap $ \case
    UserTyVar a _ c -> UserTyVar a () c
    KindedTyVar a _ c d -> KindedTyVar a () c d
    XTyVarBndr a -> XTyVarBndr a
  