{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Language.Haskell.Brittany.Internal.ToBriDoc.Type where

import qualified Data.Text as Text
import GHC (GenLocated(L))
import GHC.Hs
import GHC.Types.Var(Specificity)
import GHC.Types.SourceText(SourceText(SourceText, NoSourceText))
import qualified GHC.OldList as List
import GHC.Types.Basic
import GHC.Utils.Outputable (ftext, showSDocUnsafe)
import           GHC.Types.Fixity               ( Fixity(Fixity)
                                                , FixityDirection(InfixN)
                                                )
import Language.Haskell.Brittany.Internal.ToBriDocTools
import Language.Haskell.Brittany.Internal.Prelude
import Language.Haskell.Brittany.Internal.Types
import Language.Haskell.Brittany.Internal.Components.BriDoc
import Language.Haskell.Brittany.Internal.Utils
  (FirstLastView(..), splitFirstLast)



layoutSigType :: ToBriDoc HsSigType
-- TODO92 we ignore an ann here
layoutSigType (L _ (HsSig _ outerVarBind typ)) = case outerVarBind of
  HsOuterImplicit _       -> callLayouter2 layout_type False typ
  HsOuterExplicit _ bndrs -> do
    (headPart, restParts) <-
      splitHsForallTypeFromBinders (map withoutSpecificity bndrs) typ
    layoutSplitArrowType (headPart, restParts) (hasAnyCommentsBelow typ)

splitArrowType
  :: LHsType GhcPs
  -> ToBriDocM (OpTree, [(BriDocNumbered, OpTree)])
splitArrowType ltype@(L _ typ) = case typ of
  HsForAllTy NoExtField hsf typ1 ->
    splitHsForallTypeFromBinders (getBinders hsf) typ1
  HsQualTy NoExtField ctxMay typ1 -> do
    (innerHead, innerBody) <- splitArrowType typ1
    (wrapCtx  , cntxtDocs) <- case ctxMay of
      Nothing                            -> pure (id, [])
      Just (L (SrcSpanAnn epAnn _) ctxs) -> do
        let
          wrap = case epAnn of
            EpAnn _ (AnnContext (Just (_, loc)) _ _) _ ->
              docFlushCommsPost False (Just $ epaLocationRealSrcSpanStart loc)
                . docHandleComms epAnn
            _ -> docHandleComms epAnn
        x <- ctxs `forM` (shareDoc . layoutType False)
        pure (wrap, x)
    outerHead <- wrapCtx $ case cntxtDocs of
      []   -> docLit $ Text.pack "()"
      [x]  -> x
      docs -> docAlt
        [ let
              open  = docLit $ Text.pack "("
              close = docLit $ Text.pack ")"
              list  = List.intersperse docCommaSep $ docForceSingleline <$> docs
          in  docSeq ([open] ++ list ++ [close])
        , let
            open =
              docCols
                ColTyOpPrefix
                [docParenLSep
                             , docAddBaseY (BrIndentSpecial 2) $ head docs
                                                                          ]
            close = docLit $ Text.pack ")"
            list  = List.tail docs <&> \cntxtDoc ->
              docCols ColTyOpPrefix
                      [docCommaSep, docAddBaseY (BrIndentSpecial 2) cntxtDoc]
          in
            docPar open $ docLines $ list ++ [close]
        ]
    arrowDoc <- docLitS "=>"
    pure (OpLeaf False outerHead, (arrowDoc, innerHead) : innerBody)
  HsFunTy epAnn _ typ1 typ2 -> do
    (typ1Doc, (innerHead, innerBody)) <- do
      let
        wrapper = case epAnn of
          EpAnn _ AddSemiAnn{} _ ->
            error "brittany internal error: HsFunTy EpAnn"
          EpAnn _ AddCommaAnn{} _ ->
            error "brittany internal error: HsFunTy EpAnn"
          EpAnn _ AddVbarAnn{} _ ->
            error "brittany internal error: HsFunTy EpAnn"
          EpAnn _ (AddRarrowAnn loc) _ ->
            docFlushCommsPost True (Just $ epaLocationRealSrcSpanStart loc)
          EpAnn _ AddRarrowAnnU{} _ ->
            error "brittany internal error: HsFunTy EpAnn"
          EpAnn _ AddLollyAnnU{} _ ->
            error "brittany internal error: HsFunTy EpAnn"
          EpAnnNotUsed -> id
      typ1Doc   <- docHandleComms epAnn $ wrapper $ layoutType False typ1
      typ2Tuple <- splitArrowType typ2
      pure (typ1Doc, typ2Tuple)
    arrowDoc <- docLitS "->"
    pure $ (OpLeaf False typ1Doc, (arrowDoc, innerHead) : innerBody)
  HsParTy epAnn inner -> do
    let AnnParen _ spanOpen spanClose = anns epAnn
    (headPart, restParts) <- splitArrowType inner
    pure
      ( OpKnown ParenWithSpace
                False
                (Just $ epaLocationRealSrcSpanStart spanOpen)
                (Just $ epaLocationRealSrcSpanStart spanClose)
                (Fixity NoSourceText (-1) InfixN)
                headPart
                restParts
      , []
      )
  HsOpTy{} -> do
    (innerHead, innerRest) <- splitOpType ltype
    pure $ (OpUnknown NoParen Nothing Nothing innerHead innerRest, [])
  _ -> do
    inner <- layoutType False ltype
    pure (OpLeaf False inner, [])

splitOpType :: LHsType GhcPs -> ToBriDocM (OpTree, [(BriDocNumbered, OpTree)])
splitOpType = \case
  L _ (HsOpTy NoExtField l1 op1@(L (SrcSpanAnn _ pos) _) r1) -> do
    docL <- layoutType False l1
    docOp <- docHandleComms pos $ docLit $ printRdrNameWithAnns op1
    (innerHead, innerBody) <- splitOpType r1
    pure $ (OpLeaf False docL, (docOp, innerHead) : innerBody)
  ltype -> do
    inner <- layoutType False ltype
    pure (OpLeaf False inner, [])


splitHsForallTypeFromBinders
  :: [LHsTyVarBndr () GhcPs]
  -> LHsType GhcPs
  -> ToBriDocM
       (OpTree, [(BriDocNumbered, OpTree)])
splitHsForallTypeFromBinders binders typ = do
  (innerHead, innerBody) <- splitArrowType typ
  outerHead <- do
    tyVarDocs <- layoutTyVarBndrs binders
    docAlt
      -- :: forall x
      --  . x
      [ let open = docLit $ Text.pack "forall"
        in  docSeq (open : processTyVarBndrsSingleline tyVarDocs)
      -- :: 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 ")"
            ]
        )
      ]
  dotDoc <- docLitS "."
  pure (OpLeaf False outerHead, (dotDoc, innerHead) : innerBody)

layoutSplitArrowType
  :: (OpTree, [(BriDocNumbered, OpTree)])
  -> Bool
  -> ToBriDocM BriDocNumbered
layoutSplitArrowType (headPart, restParts) hasComments = do
  layouters <- mAsk
  let opTree =
        OpKnown NoParen
                False
                Nothing
                Nothing
                (Fixity NoSourceText (-1) InfixN)
                headPart
                restParts
  layout_opTree layouters (opTree, hasComments)


layoutType :: Bool -> ToBriDoc HsType
layoutType forceHasComms ltype@(L _ typ) = docHandleComms ltype $ case typ of
  -- _ | traceShow (ExactPrint.Types.mkAnnKey ltype) False -> error "impossible"
  HsTyVar epAnn promoted name -> docHandleComms epAnn $ do
    t <- lrdrNameToTextAnnTypeEqualityIsSpecial name
    case promoted of
      IsPromoted -> docSeq [docTick, docHandleComms name $ docLit t]
      NotPromoted -> docHandleComms name $ docLit t
  HsForAllTy{} -> do
    parts <- splitArrowType ltype
    layoutSplitArrowType parts (hasAnyCommentsBelow typ || forceHasComms)
  HsQualTy{} -> do
    parts <- splitArrowType ltype
    layoutSplitArrowType parts (hasAnyCommentsBelow typ || forceHasComms)
  HsFunTy{} -> do
    parts <- splitArrowType ltype
    layoutSplitArrowType parts (hasAnyCommentsBelow typ || forceHasComms)
  HsParTy{} -> do
    -- layouters <- mAsk
    -- treeAndHasComms <-
    --   layout_gatherOpTreeT layouters NoParen False id Nothing Nothing [] ltype
    -- layout_opTree layouters True treeAndHasComms
    parts <- splitArrowType ltype
    layoutSplitArrowType parts (hasAnyCommentsBelow typ || forceHasComms)
  HsAppTy NoExtField 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 <- shareDoc $ layoutType False typHead
    docRest <- (shareDoc . layoutType False) `mapM` typRest
    docAlt
      [ docSeq
      $ docForceSingleline docHead
      : (docRest >>= \d -> [docSeparator, docForceSingleline d])
      , docPar docHead (docLines $ docEnsureIndent BrIndentRegular <$> docRest)
      ]
  HsAppTy NoExtField typ1 typ2 -> do
    typeDoc1 <- shareDoc $ layoutType False typ1
    typeDoc2 <- shareDoc $ layoutType False typ2
    docAlt
      [ docSeq
        [docForceSingleline typeDoc1, docSeparator, docForceSingleline typeDoc2]
      , docPar typeDoc1 (docEnsureIndent BrIndentRegular typeDoc2)
      ]
  HsListTy epAnn typ1 -> docHandleComms epAnn $ do
    let (wrapOpen, wrapClose) = case epAnn of
          EpAnn _ (AnnParen _ spanOpen spanClose) _ ->
            (docHandleComms spanOpen, docHandleComms spanClose)
          EpAnnNotUsed -> (id, id)
    typeDoc1 <- shareDoc $ layoutType False typ1
    docAlt
      [ docSeq
        [ wrapOpen $ docLit $ Text.pack "["
        , docForceSingleline typeDoc1
        , wrapClose $ docLit $ Text.pack "]"
        ]
      , docSetBaseY $ docLines
        [ docCols
          ColTyOpPrefix
          [ wrapOpen $ docLit $ Text.pack "[ "
          , docAddBaseY (BrIndentSpecial 2) $ typeDoc1
          ]
        , wrapClose $ docLit $ Text.pack "]"
        ]
      ]
  HsTupleTy epAnn tupleSort typs -> docHandleComms epAnn $ case tupleSort of
    HsUnboxedTuple -> unboxed
    HsBoxedOrConstraintTuple -> simple
   where
    unboxed = if null typs
      then error "brittany internal error: unboxed unit"
      else docWith docParenHashLSep docParenHashRSep
    simple = if null typs
      then unitL
      else docWith (docLit (Text.pack "(")) (docLit (Text.pack ")"))
    unitL = docLit $ Text.pack "()"
    AnnParen _ open close = anns epAnn
    wrapStart = docHandleComms open
    wrapEnd   = docHandleComms close
    docWith start end = do
      typDocs <- typs `forM` \ty -> do
        shareDoc $ docHandleListElemComms (layoutType False) ty
      let
        line1 = docCols ColTyOpPrefix [wrapStart $ appSep start, head typDocs]
        lines =
          List.tail typDocs
            <&> \d -> docAddBaseY (BrIndentSpecial 2)
                  $ docCols ColTyOpPrefix [docCommaSep, d]
        commaDocs = List.intersperse docCommaSep (docForceSingleline <$> typDocs)
      docAlt
        [ docSeq
        $ [wrapStart start]
        ++ commaDocs
        ++ [wrapEnd end]
        , docPar
            (docAddBaseY (BrIndentSpecial 2) line1)
            (docLines $ lines ++ [wrapEnd end])
        ]
  HsOpTy{} -> do
    parts <- splitArrowType ltype
    layoutSplitArrowType parts (hasAnyCommentsBelow ltype || forceHasComms)
    -- layouters <- mAsk
    -- treeAndHasComms <-
    --   layout_gatherOpTreeT layouters NoParen False id Nothing Nothing [] ltype
    -- layout_opTree layouters treeAndHasComms
  -- 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 epAnn (L _ (HsIPName ipName)) typ1 -> do
    let posColon = obtainAnnPos epAnn AnnDcolon
    typeDoc1 <- shareDoc $ layoutType False typ1
    docHandleComms epAnn $ docAlt
      [ docSeq
        [ docLitS $ "?" ++ showSDocUnsafe (ftext ipName)
        , docHandleComms posColon $ docLitS "::"
        , docForceSingleline typeDoc1
        ]
      , docPar
        (docLit $ Text.pack ("?" ++ showSDocUnsafe (ftext ipName)))
        (docCols
          ColTyOpPrefix
          [ docHandleComms posColon $ docLit $ Text.pack ":: "
          , docAddBaseY (BrIndentSpecial 2) typeDoc1
          ]
        )
      ]
  -- TODO: test KindSig
  HsKindSig epAnn typ1 kind1 -> do
    let posColon = obtainAnnPos epAnn AnnDcolon
    typeDoc1 <- shareDoc $ layoutType False typ1
    kindDoc1 <- shareDoc $ layoutType False kind1
    docAlt
      [ docSeq
          [ docForceSingleline typeDoc1
          , docSeparator
          , docHandleComms posColon $ docLit $ Text.pack "::"
          , docSeparator
          , docForceSingleline kindDoc1
          ]
      , docPar
          typeDoc1
          (docCols
            ColTyOpPrefix
            [ docHandleComms posColon $ docLit $ Text.pack ":: "
            , docAddBaseY (BrIndentSpecial 3) kindDoc1
            ]
          )
      ]
  HsBangTy epAnn (HsSrcBang NoSourceText NoSrcUnpack SrcStrict) innerTy -> do
    docHandleComms epAnn $ docSeq [docLitS "!", layoutType False innerTy]
  HsBangTy {} ->
    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 epAnn _ typs -> docHandleComms epAnn $ do
    -- `'['Foo]` isn't valid because it parses as a character. So if the list
    -- starts with a promoted type var, we swap to `'[ 'Foo ]`.
    let
      sepIfHeadPromoted = case typs of
        (L _ t) : _ | startsWithTick t -> docSeparator
        _ -> docEmpty

    -- When rendering on multiple lines, this causes commas to line up with the
    -- opening bracket. Unfortunately it also adds unnecessary space when
    -- rendering on a single line.
    let specialCommaSep = appSep $ docLit $ Text.pack " ,"

    typDocs <-
      typs `forM` (shareDoc . docHandleListElemComms (layoutType False))
    let hasComments = hasAnyCommentsBelow ltype
    case splitFirstLast typDocs of
      FirstLastEmpty -> docSeq
        [ docLit $ Text.pack "'[]" -- TODO92 comments AnnOpenS
        ]
      FirstLastSingleton e -> docAlt
        [ docSeq
          [ docLit $ Text.pack "'["
          , sepIfHeadPromoted
          , docForceSingleline e -- TODO92 comments AnnOpenS
          , sepIfHeadPromoted
          , docLit $ Text.pack "]"
          ]
        , docSetBaseY $ docLines
          [ docSeq
            [ docLit $ Text.pack "'["
            , docSeparator
            , docSetBaseY $ e -- TODO92 comments AnnOpenS
            ]
          , docLit $ Text.pack " ]"
          ]
        ]
      FirstLast e1 ems eN -> runFilteredAlternative $ do
        addAlternativeCond (not hasComments)
          $ docSeq
          $ [docLit $ Text.pack "'[", sepIfHeadPromoted]
          ++ List.intersperse
               docCommaSep
               (docForceSingleline
               <$> (e1 : ems ++ [eN]) -- TODO92 comments AnnOpenS
               )
          ++ [sepIfHeadPromoted, docLit $ Text.pack "]"]
        addAlternative
          $ let
              start = docCols ColList [appSep $ docLit $ Text.pack "'[", e1]
              linesM = ems <&> \d -> docCols ColList [specialCommaSep, d]
              lineN = docCols
                ColList
                [specialCommaSep, eN] -- TODO92 comments AnnOpenS
              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"
    HsCharTy (SourceText srctext) _ -> docLit $ Text.pack srctext
    HsCharTy 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 <- shareDoc $ layoutType False ty
    k <- shareDoc $ layoutType False 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 <- shareDoc $ layoutType False 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 GhcPs -> [LHsTyVarBndr () GhcPs]
getBinders x = case x of
  HsForAllVis _ b -> b
  HsForAllInvis _ b -> fmap withoutSpecificity b

withoutSpecificity :: LHsTyVarBndr GHC.Types.Var.Specificity GhcPs -> LHsTyVarBndr () GhcPs
withoutSpecificity = fmap $ \case
  UserTyVar a _ c -> UserTyVar a () c
  KindedTyVar a _ c d -> KindedTyVar a () c d

-- | Determine if the type starts with a tick mark (single quote) when rendered.
startsWithTick :: HsType GhcPs -> Bool
startsWithTick = \case
  HsTyVar _ IsPromoted _ -> True
  HsAppTy _ (L _ t) _ -> startsWithTick t
  _ -> False
