content: -- | This module contains functions for converting the CST into the core AST. It
  -- is mostly boilerplate, and does the job of resolving ranges for all the nodes
  -- and attaching comments.
  
  module Language.PureScript.CST.Convert
    ( convertType
    , convertExpr
    , convertBinder
    , convertDeclaration
    , convertImportDecl
    , convertModule
    , sourcePos
    , sourceSpan
    , comment
    , comments
    ) where
  
  import Prelude hiding (take)
  import Protolude (headDef)
  
  import Data.Bifunctor (bimap, first)
  import Data.Char (toLower)
  import Data.Foldable (foldl', toList)
  import Data.Functor (($>))
  import Data.List.NonEmpty qualified as NE
  import Data.Maybe (isJust, fromJust, mapMaybe)
  import Data.Text qualified as Text
  import Language.PureScript.AST qualified as AST
  import Language.PureScript.AST.Declarations.ChainId (mkChainId)
  import Language.PureScript.AST.SourcePos qualified as Pos
  import Language.PureScript.Comments qualified as C
  import Language.PureScript.Crash (internalError)
  import Language.PureScript.Environment qualified as Env
  import Language.PureScript.Label qualified as L
  import Language.PureScript.Names qualified as N
  import Language.PureScript.PSString (mkString, prettyPrintStringJS)
  import Language.PureScript.Types qualified as T
  import Language.PureScript.CST.Positions
  import Language.PureScript.CST.Print (printToken)
  import Language.PureScript.CST.Types
  
  comment :: Comment a -> Maybe C.Comment
  comment = \case
    Comment t
      | "{-" `Text.isPrefixOf` t -> Just $ C.BlockComment $ Text.drop 2 $ Text.dropEnd 2 t
      | "--" `Text.isPrefixOf` t -> Just $ C.LineComment $ Text.drop 2 t
    _ -> Nothing
  
  comments :: [Comment a] -> [C.Comment]
  comments = mapMaybe comment
  
  sourcePos :: SourcePos -> Pos.SourcePos
  sourcePos (SourcePos line col) = Pos.SourcePos line col
  
  sourceSpan :: String -> SourceRange -> Pos.SourceSpan
  sourceSpan name (SourceRange start end) = Pos.SourceSpan name (sourcePos start) (sourcePos end)
  
  widenLeft :: TokenAnn -> Pos.SourceAnn -> Pos.SourceAnn
  widenLeft ann (sp, _) =
    ( Pos.widenSourceSpan (sourceSpan (Pos.spanName sp) $ tokRange ann) sp
    , comments $ tokLeadingComments ann
    )
  
  sourceAnnCommented :: String -> SourceToken -> SourceToken -> Pos.SourceAnn
  sourceAnnCommented fileName (SourceToken ann1 _) (SourceToken ann2 _) =
    ( Pos.SourceSpan fileName (sourcePos $ srcStart $ tokRange ann1) (sourcePos $ srcEnd $ tokRange ann2)
    , comments $ tokLeadingComments ann1
    )
  
  sourceAnn :: String -> SourceToken -> SourceToken -> Pos.SourceAnn
  sourceAnn fileName (SourceToken ann1 _) (SourceToken ann2 _) =
    ( Pos.SourceSpan fileName (sourcePos $ srcStart $ tokRange ann1) (sourcePos $ srcEnd $ tokRange ann2)
    , []
    )
  
  sourceName :: String -> Name a -> Pos.SourceAnn
  sourceName fileName a = sourceAnnCommented fileName (nameTok a) (nameTok a)
  
  sourceQualName :: String -> QualifiedName a -> Pos.SourceAnn
  sourceQualName fileName a = sourceAnnCommented fileName (qualTok a) (qualTok a)
  
  moduleName :: Token -> Maybe N.ModuleName
  moduleName = \case
    TokLowerName as _ -> go as
    TokUpperName as _ -> go as
    TokSymbolName as _ -> go as
    TokOperator as _ -> go as
    _ -> Nothing
    where
    go [] = Nothing
    go ns = Just $ N.ModuleName $ Text.intercalate "." ns
  
  qualified :: QualifiedName a -> N.Qualified a
  qualified q = N.Qualified qb (qualName q)
    where
    qb = maybe N.ByNullSourcePos N.ByModuleName $ qualModule q
  
  ident :: Ident -> N.Ident
  ident = N.Ident . getIdent
  
  convertType :: String -> Type a -> T.SourceType
  convertType = convertType' False
  
  convertVtaType :: String -> Type a -> T.SourceType
  convertVtaType = convertType' True
  
  convertType' :: Bool -> String -> Type a -> T.SourceType
  convertType' withinVta fileName = go
    where
    goRow (Row labels tl) b = do
      let
        rowTail = case tl of
          Just (_, ty) -> go ty
          Nothing -> T.REmpty $ sourceAnnCommented fileName b b
        rowCons (Labeled a _ ty) c = do
          let ann = sourceAnnCommented fileName (lblTok a) (snd $ typeRange ty)
          T.RCons ann (L.Label $ lblName a) (go ty) c
      case labels of
        Just (Separated h t) ->
          rowCons h $ foldr (rowCons . snd) rowTail t
        Nothing ->
          rowTail
  
    go = \case
      TypeVar _ a ->
        T.TypeVar (sourceName fileName a) . getIdent $ nameValue a
      TypeConstructor _ a ->
        T.TypeConstructor (sourceQualName fileName a) $ qualified a
      TypeWildcard _ a ->
        T.TypeWildcard (sourceAnnCommented fileName a a) $ if withinVta then T.IgnoredWildcard else T.UnnamedWildcard
      TypeHole _ a ->
        T.TypeWildcard (sourceName fileName a) . T.HoleWildcard . getIdent $ nameValue a
      TypeString _ a b ->
        T.TypeLevelString (sourceAnnCommented fileName a a) b
      TypeInt _ _ a b ->
        T.TypeLevelInt (sourceAnnCommented fileName a a) b
      TypeRow _ (Wrapped _ row b) ->
        goRow row b
      TypeRecord _ (Wrapped a row b) -> do
        let
          ann = sourceAnnCommented fileName a b
          annRec = sourceAnn fileName a a
        T.TypeApp ann (Env.tyRecord $> annRec) $ goRow row b
      TypeForall _ kw bindings _ ty -> do
        let
          mkForAll a b v t = do
            let ann' = widenLeft (tokAnn $ nameTok a) $ T.getAnnForType t
            T.ForAll ann' (maybe T.TypeVarInvisible (const T.TypeVarVisible) v) (getIdent $ nameValue a) b t Nothing
          k (TypeVarKinded (Wrapped _ (Labeled (v, a) _ b) _)) = mkForAll a (Just (go b)) v
          k (TypeVarName (v, a)) = mkForAll a Nothing v
          ty' = foldr k (go ty) bindings
          ann = widenLeft (tokAnn kw) $ T.getAnnForType ty'
        T.setAnnForType ann ty'
      TypeKinded _ ty _ kd -> do
        let
          ty' = go ty
          kd' = go kd
          ann = Pos.widenSourceAnn (T.getAnnForType ty') (T.getAnnForType kd')
        T.KindedType ann ty' kd'
      TypeApp _ a b -> do
        let
          a' = go a
          b' = go b
          ann = Pos.widenSourceAnn (T.getAnnForType a') (T.getAnnForType b')
        T.TypeApp ann a' b'
      ty@(TypeOp _ _ _ _) -> do
        let
          reassoc op b' a = do
            let
              a'  = go a
              op' = T.TypeOp (sourceQualName fileName op) $ qualified op
              ann = Pos.widenSourceAnn (T.getAnnForType a') (T.getAnnForType b')
            T.BinaryNoParensType ann op' (go a) b'
          loop k = \case
            TypeOp _ a op b -> loop (reassoc op (k b)) a
            expr' -> k expr'
        loop go ty
      TypeOpName _ op -> do
        let rng = qualRange op
        T.TypeOp (uncurry (sourceAnnCommented fileName) rng) (qualified op)
      TypeArr _ a arr b -> do
        let
          a' = go a
          b' = go b
          arr' = Env.tyFunction $> sourceAnnCommented fileName arr arr
          ann = Pos.widenSourceAnn (T.getAnnForType a') (T.getAnnForType b')
        T.TypeApp ann (T.TypeApp ann arr' a') b'
      TypeArrName _ a ->
        Env.tyFunction $> sourceAnnCommented fileName a a
      TypeConstrained _ a _ b -> do
        let
          a' = convertConstraint withinVta fileName a
          b' = go b
          ann = Pos.widenSourceAnn (T.constraintAnn a') (T.getAnnForType b')
        T.ConstrainedType ann a' b'
      TypeParens _ (Wrapped a ty b) ->
        T.ParensInType (sourceAnnCommented fileName a b) $ go ty
      ty@(TypeUnaryRow _ _ a) -> do
        let
          a' = go a
          rng = typeRange ty
          ann = uncurry (sourceAnnCommented fileName) rng
        T.setAnnForType ann $ Env.kindRow a'
  
  convertConstraint :: Bool -> String -> Constraint a -> T.SourceConstraint
  convertConstraint withinVta fileName = go
    where
    go = \case
      cst@(Constraint _ name args) -> do
        let ann = uncurry (sourceAnnCommented fileName) $ constraintRange cst
        T.Constraint ann (qualified name) [] (convertType' withinVta fileName <$> args) Nothing
      ConstraintParens _ (Wrapped _ c _) -> go c
  
  convertGuarded :: String -> Guarded a -> [AST.GuardedExpr]
  convertGuarded fileName = \case
    Unconditional _ x -> [AST.GuardedExpr [] (convertWhere fileName x)]
    Guarded gs -> (\(GuardedExpr _ ps _ x) -> AST.GuardedExpr (p <$> toList ps) (convertWhere fileName x)) <$> NE.toList gs
    where
    go = convertExpr fileName
    p (PatternGuard Nothing x) = AST.ConditionGuard (go x)
    p (PatternGuard (Just (b, _)) x) = AST.PatternGuard (convertBinder fileName b) (go x)
  
  convertWhere :: String -> Where a -> AST.Expr
  convertWhere fileName = \case
    Where expr Nothing -> convertExpr fileName expr
    Where expr (Just (_, bs)) -> do
      let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
      uncurry AST.PositionedValue ann . AST.Let AST.FromWhere (convertLetBinding fileName <$> NE.toList bs) $ convertExpr fileName expr
  
  convertLetBinding :: String -> LetBinding a -> AST.Declaration
  convertLetBinding fileName = \case
    LetBindingSignature _ lbl ->
      convertSignature fileName lbl
    binding@(LetBindingName _ fields) -> do
      let ann = uncurry (sourceAnnCommented fileName) $ letBindingRange binding
      convertValueBindingFields fileName ann fields
    binding@(LetBindingPattern _ a _ b) -> do
      let ann = uncurry (sourceAnnCommented fileName) $ letBindingRange binding
      AST.BoundValueDeclaration ann (convertBinder fileName a) (convertWhere fileName b)
  
  convertExpr :: forall a. String -> Expr a -> AST.Expr
  convertExpr fileName = go
    where
    positioned =
      uncurry AST.PositionedValue
  
    goDoStatement = \case
      stmt@(DoLet _ as) -> do
        let ann = uncurry (sourceAnnCommented fileName) $ doStatementRange stmt
        uncurry AST.PositionedDoNotationElement ann . AST.DoNotationLet $ convertLetBinding fileName <$> NE.toList as
      stmt@(DoDiscard a) -> do
        let ann = uncurry (sourceAnn fileName) $ doStatementRange stmt
        uncurry AST.PositionedDoNotationElement ann . AST.DoNotationValue $ go a
      stmt@(DoBind a _ b) -> do
        let
          ann = uncurry (sourceAnn fileName) $ doStatementRange stmt
          a' = convertBinder fileName a
          b' = go b
        uncurry AST.PositionedDoNotationElement ann $ AST.DoNotationBind a' b'
  
    go = \case
      ExprHole _ a ->
        positioned (sourceName fileName a) . AST.Hole . getIdent $ nameValue a
      ExprSection _ a ->
        positioned (sourceAnnCommented fileName a a) AST.AnonymousArgument
      ExprIdent _ a -> do
        let ann = sourceQualName fileName a
        positioned ann . AST.Var (fst ann) . qualified $ fmap ident a
      ExprConstructor _ a -> do
        let ann = sourceQualName fileName a
        positioned ann . AST.Constructor (fst ann) $ qualified a
      ExprBoolean _ a b -> do
        let ann = sourceAnnCommented fileName a a
        positioned ann . AST.Literal (fst ann) $ AST.BooleanLiteral b
      ExprChar _ a b -> do
        let ann = sourceAnnCommented fileName a a
        positioned ann . AST.Literal (fst ann) $ AST.CharLiteral b
      ExprString _ a b -> do
        let ann = sourceAnnCommented fileName a a
        positioned ann . AST.Literal (fst ann) . AST.StringLiteral $ b
      ExprNumber _ a b -> do
        let ann = sourceAnnCommented fileName a a
        positioned ann . AST.Literal (fst ann) $ AST.NumericLiteral b
      ExprArray _ (Wrapped a bs c) -> do
        let
          ann = sourceAnnCommented fileName a c
          vals = case bs of
            Just (Separated x xs) -> go x : (go . snd <$> xs)
            Nothing -> []
        positioned ann . AST.Literal (fst ann) $ AST.ArrayLiteral vals
      ExprRecord z (Wrapped a bs c) -> do
        let
          ann = sourceAnnCommented fileName a c
          lbl = \case
            RecordPun f -> (mkString . getIdent $ nameValue f, go . ExprIdent z $ QualifiedName (nameTok f) Nothing (nameValue f))
            RecordField f _ v -> (lblName f, go v)
          vals = case bs of
            Just (Separated x xs) -> lbl x : (lbl . snd <$> xs)
            Nothing -> []
        positioned ann . AST.Literal (fst ann) $ AST.ObjectLiteral vals
      ExprParens _ (Wrapped a b c) ->
        positioned (sourceAnnCommented fileName a c) . AST.Parens $ go b
      expr@(ExprTyped _ a _ b) -> do
        let
          a' = go a
          b' = convertType fileName b
          ann = (sourceSpan fileName . toSourceRange $ exprRange expr, [])
        positioned ann $ AST.TypedValue True a' b'
      expr@(ExprInfix _ a (Wrapped _ b _) c) -> do
        let ann = (sourceSpan fileName . toSourceRange $ exprRange expr, [])
        positioned ann $ AST.BinaryNoParens (go b) (go a) (go c)
      expr@(ExprOp _ _ _ _) -> do
        let
          ann = uncurry (sourceAnn fileName) $ exprRange expr
          reassoc op b a = do
            let op' = AST.Op (sourceSpan fileName . toSourceRange $ qualRange op) $ qualified op
            AST.BinaryNoParens op' (go a) b
          loop k = \case
            ExprOp _ a op b -> loop (reassoc op (k b)) a
            expr' -> k expr'
        positioned ann $ loop go expr
      ExprOpName _ op -> do
        let
          rng = qualRange op
          op' = AST.Op (sourceSpan fileName $ toSourceRange rng) $ qualified op
        positioned (uncurry (sourceAnnCommented fileName) rng) op'
      expr@(ExprNegate _ _ b) -> do
        let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
        positioned ann . AST.UnaryMinus (fst ann) $ go b
      expr@(ExprRecordAccessor _ (RecordAccessor a _ (Separated h t))) -> do
        let
          ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
          field x f = AST.Accessor (lblName f) x
        positioned ann $ foldl' (\x (_, f) -> field x f) (field (go a) h) t
      expr@(ExprRecordUpdate _ a b) -> do
        let
          ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
          k (RecordUpdateLeaf f _ x) = (lblName f, AST.Leaf $ go x)
          k (RecordUpdateBranch f xs) = (lblName f, AST.Branch $ toTree xs)
          toTree (Wrapped _ xs _) = AST.PathTree . AST.AssocList . map k $ toList xs
        positioned ann . AST.ObjectUpdateNested (go a) $ toTree b
      expr@(ExprApp _ a b) -> do
        let ann = uncurry (sourceAnn fileName) $ exprRange expr
        positioned ann $ AST.App (go a) (go b)
      expr@(ExprVisibleTypeApp _ a _ b) -> do
        let ann = uncurry (sourceAnn fileName) $ exprRange expr
        positioned ann $ AST.VisibleTypeApp (go a) (convertVtaType fileName b)
      expr@(ExprLambda _ (Lambda _ as _ b)) -> do
        let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
        positioned ann
          . AST.Abs (convertBinder fileName (NE.head as))
          . foldr (AST.Abs . convertBinder fileName) (go b)
          $ NE.tail as
      expr@(ExprIf _ (IfThenElse _ a _ b _ c)) -> do
        let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
        positioned ann $ AST.IfThenElse (go a) (go b) (go c)
      expr@(ExprCase _ (CaseOf _ as _ bs)) -> do
        let
          ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
          as' = go <$> toList as
          bs' = uncurry AST.CaseAlternative . bimap (map (convertBinder fileName) . toList) (convertGuarded fileName) <$> NE.toList bs
        positioned ann $ AST.Case as' bs'
      expr@(ExprLet _ (LetIn _ as _ b)) -> do
        let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
        positioned ann . AST.Let AST.FromLet (convertLetBinding fileName <$> NE.toList as) $ go b
      -- expr@(ExprWhere _ (Where a _ bs)) -> do
      --   let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
      --   positioned ann . AST.Let AST.FromWhere (goLetBinding <$> bs) $ go a
      expr@(ExprDo _ (DoBlock kw stmts)) -> do
        let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
        positioned ann . AST.Do (moduleName $ tokValue kw) $ goDoStatement <$> NE.toList stmts
      expr@(ExprAdo _ (AdoBlock kw stms _ a)) -> do
        let ann = uncurry (sourceAnnCommented fileName) $ exprRange expr
        positioned ann . AST.Ado (moduleName $ tokValue kw) (goDoStatement <$> stms) $ go a
  
  convertBinder :: String -> Binder a -> AST.Binder
  convertBinder fileName = go
    where
    positioned =
      uncurry AST.PositionedBinder
  
    go = \case
      BinderWildcard _ a ->
        positioned (sourceAnnCommented fileName a a) AST.NullBinder
      BinderVar _ a -> do
        let ann = sourceName fileName a
        positioned ann . AST.VarBinder (fst ann) . ident $ nameValue a
      binder@(BinderNamed _ a _ b) -> do
        let ann = uncurry (sourceAnnCommented fileName) $ binderRange binder
        positioned ann . AST.NamedBinder (fst ann) (ident $ nameValue a) $ go b
      binder@(BinderConstructor _ a bs) -> do
        let ann = uncurry (sourceAnnCommented fileName) $ binderRange binder
        positioned ann . AST.ConstructorBinder (fst ann) (qualified a) $ go <$> bs
      BinderBoolean _ a b -> do
        let ann = sourceAnnCommented fileName a a
        positioned ann . AST.LiteralBinder (fst ann) $ AST.BooleanLiteral b
      BinderChar _ a b -> do
        let ann = sourceAnnCommented fileName a a
        positioned ann . AST.LiteralBinder (fst ann) $ AST.CharLiteral b
      BinderString _ a b -> do
        let ann = sourceAnnCommented fileName a a
        positioned ann . AST.LiteralBinder (fst ann) . AST.StringLiteral $ b
      BinderNumber _ n a b -> do
        let
          ann = sourceAnnCommented fileName a a
          b'
            | isJust n = bimap negate negate b
            | otherwise = b
        positioned ann . AST.LiteralBinder (fst ann) $ AST.NumericLiteral b'
      BinderArray _ (Wrapped a bs c) -> do
        let
          ann = sourceAnnCommented fileName a c
          vals = case bs of
            Just (Separated x xs) -> go x : (go . snd <$> xs)
            Nothing -> []
        positioned ann . AST.LiteralBinder (fst ann) $ AST.ArrayLiteral vals
      BinderRecord z (Wrapped a bs c) -> do
        let
          ann = sourceAnnCommented fileName a c
          lbl = \case
            RecordPun f -> (mkString . getIdent $ nameValue f, go $ BinderVar z f)
            RecordField f _ v -> (lblName f, go v)
          vals = case bs of
            Just (Separated x xs) -> lbl x : (lbl . snd <$> xs)
            Nothing -> []
        positioned ann . AST.LiteralBinder (fst ann) $ AST.ObjectLiteral vals
      BinderParens _ (Wrapped a b c) ->
        positioned (sourceAnnCommented fileName a c) . AST.ParensInBinder $ go b
      binder@(BinderTyped _ a _ b) -> do
        let
          a' = go a
          b' = convertType fileName b
          ann = (sourceSpan fileName . toSourceRange $ binderRange binder, [])
        positioned ann $ AST.TypedBinder b' a'
      binder@(BinderOp _ _ _ _) -> do
        let
          ann = uncurry (sourceAnn fileName) $ binderRange binder
          reassoc op b a = do
            let op' = AST.OpBinder (sourceSpan fileName . toSourceRange $ qualRange op) $ qualified op
            AST.BinaryNoParensBinder op' (go a) b
          loop k = \case
            BinderOp _ a op b -> loop (reassoc op (k b)) a
            binder' -> k binder'
        positioned ann $ loop go binder
  
  convertDeclaration :: String -> Declaration a -> [AST.Declaration]
  convertDeclaration fileName decl = case decl of
    DeclData _ (DataHead _ a vars) bd -> do
      let
        ctrs :: SourceToken -> DataCtor b -> [(SourceToken, DataCtor b)] -> [AST.DataConstructorDeclaration]
        ctrs st (DataCtor _ name fields) tl
          = AST.DataConstructorDeclaration (sourceAnnCommented fileName st (nameTok name)) (nameValue name) (zip ctrFields $ convertType fileName <$> fields)
          : (case tl of
              [] -> []
              (st', ctor) : tl' -> ctrs st' ctor tl'
            )
      pure $ AST.DataDeclaration ann Env.Data (nameValue a) (goTypeVar <$> vars) (maybe [] (\(st, Separated hd tl) -> ctrs st hd tl) bd)
    DeclType _ (DataHead _ a vars) _ bd ->
      pure $ AST.TypeSynonymDeclaration ann
        (nameValue a)
        (goTypeVar <$> vars)
        (convertType fileName bd)
    DeclNewtype _ (DataHead _ a vars) st x ys -> do
      let ctrs = [AST.DataConstructorDeclaration (sourceAnnCommented fileName st (snd $ declRange decl)) (nameValue x) [(headDef (internalError "No constructor name") ctrFields, convertType fileName ys)]]
      pure $ AST.DataDeclaration ann Env.Newtype (nameValue a) (goTypeVar <$> vars) ctrs
    DeclClass _ (ClassHead _ sup name vars fdeps) bd -> do
      let
        goTyVar (TypeVarKinded (Wrapped _ (Labeled (_, a) _ _) _)) = nameValue a
        goTyVar (TypeVarName (_, a)) = nameValue a
        vars' = zip (toList $ goTyVar <$> vars) [0..]
        goName = fromJust . flip lookup vars' . nameValue
        goFundep (FundepDetermined _ bs) = Env.FunctionalDependency [] (goName <$> NE.toList bs)
        goFundep (FundepDetermines as _ bs) = Env.FunctionalDependency (goName <$> NE.toList as) (goName <$> NE.toList bs)
        goSig (Labeled n _ ty) = do
          let
            ty' = convertType fileName ty
            ann' = widenLeft (tokAnn $ nameTok n) $ T.getAnnForType ty'
          AST.TypeDeclaration $ AST.TypeDeclarationData ann' (ident $ nameValue n) ty'
      pure $ AST.TypeClassDeclaration ann
        (nameValue name)
        (goTypeVar <$> vars)
        (convertConstraint False fileName <$> maybe [] (toList . fst) sup)
        (goFundep <$> maybe [] (toList . snd) fdeps)
        (goSig <$> maybe [] (NE.toList . snd) bd)
    DeclInstanceChain _ insts -> do
      let
        chainId = mkChainId fileName $ startSourcePos $ instKeyword $ instHead $ sepHead insts
        goInst ix inst@(Instance (InstanceHead _ nameSep ctrs cls args) bd) = do
          let ann' = uncurry (sourceAnnCommented fileName) $ instanceRange inst
              clsAnn = findInstanceAnn cls args
          AST.TypeInstanceDeclaration ann' clsAnn chainId ix
            (mkPartialInstanceName nameSep cls args)
            (convertConstraint False fileName <$> maybe [] (toList . fst) ctrs)
            (qualified cls)
            (convertType fileName <$> args)
            (AST.ExplicitInstance $ goInstanceBinding <$> maybe [] (NE.toList . snd) bd)
      uncurry goInst <$> zip [0..] (toList insts)
    DeclDerive _ _ new (InstanceHead kw nameSep ctrs cls args) -> do
      let
        chainId = mkChainId fileName $ startSourcePos kw
        name' = mkPartialInstanceName nameSep cls args
        instTy
          | isJust new = AST.NewtypeInstance
          | otherwise = AST.DerivedInstance
        clsAnn = findInstanceAnn cls args
      pure $ AST.TypeInstanceDeclaration ann clsAnn chainId 0 name'
        (convertConstraint False fileName <$> maybe [] (toList . fst) ctrs)
        (qualified cls)
        (convertType fileName <$> args)
        instTy
    DeclKindSignature _ kw (Labeled name _ ty) -> do
      let
        kindFor = case tokValue kw of
          TokLowerName [] "data" -> AST.DataSig
          TokLowerName [] "newtype" -> AST.NewtypeSig
          TokLowerName [] "type" -> AST.TypeSynonymSig
          TokLowerName [] "class" -> AST.ClassSig
          tok -> internalError $ "Invalid kind signature keyword " <> Text.unpack (printToken tok)
      pure . AST.KindDeclaration ann kindFor (nameValue name) $ convertType fileName ty
    DeclSignature _ lbl ->
      pure $ convertSignature fileName lbl
    DeclValue _ fields ->
      pure $ convertValueBindingFields fileName ann fields
    DeclFixity _ (FixityFields (_, kw) (_, prec) fxop) -> do
      let
        assoc =  case kw of
          Infix  -> AST.Infix
          Infixr -> AST.Infixr
          Infixl -> AST.Infixl
        fixity = AST.Fixity assoc prec
      pure $ AST.FixityDeclaration ann $ case fxop of
        FixityValue name _ op -> do
          Left $ AST.ValueFixity fixity (first ident <$> qualified name) (nameValue op)
        FixityType _ name _ op ->
          Right $ AST.TypeFixity fixity (qualified name) (nameValue op)
    DeclForeign _ _ _ frn ->
      pure $ case frn of
        ForeignValue (Labeled a _ b) ->
          AST.ExternDeclaration ann (ident $ nameValue a) $ convertType fileName b
        ForeignData _ (Labeled a _ b) ->
          AST.ExternDataDeclaration ann (nameValue a) $ convertType fileName b
        ForeignKind _ a ->
          AST.DataDeclaration ann Env.Data (nameValue a) [] []
    DeclRole _ _ _ name roles ->
      pure $ AST.RoleDeclaration $
        AST.RoleDeclarationData ann (nameValue name) (roleValue <$> NE.toList roles)
    where
    ann =
      uncurry (sourceAnnCommented fileName) $ declRange decl
  
    startSourcePos :: SourceToken -> Pos.SourcePos
    startSourcePos = sourcePos . srcStart . tokRange . tokAnn
  
    mkPartialInstanceName :: Maybe (Name Ident, SourceToken) -> QualifiedName (N.ProperName 'N.ClassName) -> [Type a] -> Either Text.Text N.Ident
    mkPartialInstanceName nameSep cls args =
      maybe (Left genName) (Right . ident . nameValue . fst) nameSep
      where
        -- truncate to 25 chars to reduce verbosity
        -- of name and still keep it readable
        -- name will be used to create a GenIdent
        -- in desugaring process
        genName :: Text.Text
        genName = Text.take 25 (className <> typeArgs)
  
        className :: Text.Text
        className
          = foldMap (uncurry Text.cons . first toLower)
          . Text.uncons
          . N.runProperName
          $ qualName cls
  
        typeArgs :: Text.Text
        typeArgs = foldMap argName args
  
        argName :: Type a -> Text.Text
        argName = \case
          -- These are only useful to disambiguate between overlapping instances
          -- but they’re disallowed outside of instance chains. Since we’re
          -- avoiding name collisions with unique identifiers anyway,
          -- we don't need to render this constructor.
          TypeVar{} -> ""
          TypeConstructor _ qn -> N.runProperName $ qualName qn
          TypeOpName _ qn -> N.runOpName $ qualName qn
          TypeString _ _ ps -> prettyPrintStringJS ps
          TypeInt _ _ _ nt -> Text.pack $ show nt
  
          -- Typed holes are disallowed in instance heads
          TypeHole{} -> ""
          TypeParens _ t -> argName $ wrpValue t
          TypeKinded _ t1 _ t2 -> argName t1 <> argName t2
          TypeRecord _ _ -> "Record"
          TypeRow _ _ -> "Row"
          TypeArrName _ _ -> "Function"
          TypeWildcard{} -> "_"
  
          -- Polytypes are disallowed in instance heads
          TypeForall{} -> ""
          TypeApp _ t1 t2 -> argName t1 <> argName t2
          TypeOp _ t1 op t2 ->
            argName t1 <> N.runOpName (qualName op) <> argName t2
          TypeArr _ t1 _ t2 -> argName t1 <> "Function" <> argName t2
          TypeConstrained{} -> ""
          TypeUnaryRow{} -> "Row"
  
    goTypeVar = \case
      TypeVarKinded (Wrapped _ (Labeled (_, x) _ y) _) -> (getIdent $ nameValue x, Just $ convertType fileName y)
      TypeVarName (_, x) -> (getIdent $ nameValue x, Nothing)
  
    goInstanceBinding = \case
      InstanceBindingSignature _ lbl ->
        convertSignature fileName lbl
      binding@(InstanceBindingName _ fields) -> do
        let ann' = uncurry (sourceAnnCommented fileName) $ instanceBindingRange binding
        convertValueBindingFields fileName ann' fields
  
    findInstanceAnn cls args = uncurry (sourceAnnCommented fileName) $
      if null args then
        qualRange cls
      else
        (fst $ qualRange cls, snd $ typeRange $ last args)
  
  convertSignature :: String -> Labeled (Name Ident) (Type a) -> AST.Declaration
  convertSignature fileName (Labeled a _ b) = do
    let
      b' = convertType fileName b
      ann = widenLeft (tokAnn $ nameTok a) $ T.getAnnForType b'
    AST.TypeDeclaration $ AST.TypeDeclarationData ann (ident $ nameValue a) b'
  
  convertValueBindingFields :: String -> Pos.SourceAnn -> ValueBindingFields a -> AST.Declaration
  convertValueBindingFields fileName ann (ValueBindingFields a bs c) = do
    let
      bs' = convertBinder fileName <$> bs
      cs' = convertGuarded fileName c
    AST.ValueDeclaration $ AST.ValueDeclarationData ann (ident $ nameValue a) Env.Public bs' cs'
  
  convertImportDecl
    :: String
    -> ImportDecl a
    -> (Pos.SourceAnn, N.ModuleName, AST.ImportDeclarationType, Maybe N.ModuleName)
  convertImportDecl fileName decl@(ImportDecl _ _ modName mbNames mbQual) = do
    let
      ann = uncurry (sourceAnnCommented fileName) $ importDeclRange decl
      importTy = case mbNames of
        Nothing -> AST.Implicit
        Just (hiding, Wrapped _ imps _) -> do
          let imps' = convertImport fileName <$> toList imps
          if isJust hiding
            then AST.Hiding imps'
            else AST.Explicit imps'
    (ann, nameValue modName, importTy, nameValue . snd <$> mbQual)
  
  convertImport :: String -> Import a -> AST.DeclarationRef
  convertImport fileName imp = case imp of
    ImportValue _ a ->
      AST.ValueRef ann . ident $ nameValue a
    ImportOp _ a ->
      AST.ValueOpRef ann $ nameValue a
    ImportType _ a mb -> do
      let
        ctrs = case mb of
          Nothing -> Just []
          Just (DataAll _ _) -> Nothing
          Just (DataEnumerated _ (Wrapped _ Nothing _)) -> Just []
          Just (DataEnumerated _ (Wrapped _ (Just idents) _)) ->
            Just . map nameValue $ toList idents
      AST.TypeRef ann (nameValue a) ctrs
    ImportTypeOp _ _ a ->
      AST.TypeOpRef ann $ nameValue a
    ImportClass _ _ a ->
      AST.TypeClassRef ann $ nameValue a
    where
    ann = sourceSpan fileName . toSourceRange $ importRange imp
  
  convertExport :: String -> Export a -> AST.DeclarationRef
  convertExport fileName export = case export of
    ExportValue _ a ->
      AST.ValueRef ann . ident $ nameValue a
    ExportOp _ a ->
      AST.ValueOpRef ann $ nameValue a
    ExportType _ a mb -> do
      let
        ctrs = case mb of
          Nothing -> Just []
          Just (DataAll _ _) -> Nothing
          Just (DataEnumerated _ (Wrapped _ Nothing _)) -> Just []
          Just (DataEnumerated _ (Wrapped _ (Just idents) _)) ->
            Just . map nameValue $ toList idents
      AST.TypeRef ann (nameValue a) ctrs
    ExportTypeOp _ _ a ->
      AST.TypeOpRef ann $ nameValue a
    ExportClass _ _ a ->
      AST.TypeClassRef ann $ nameValue a
    ExportModule _ _ a ->
      AST.ModuleRef ann (nameValue a)
    where
    ann = sourceSpan fileName . toSourceRange $ exportRange export
  
  convertModule :: String -> Module a -> AST.Module
  convertModule fileName module'@(Module _ _ modName exps _ imps decls _) = do
    let
      ann = uncurry (sourceAnnCommented fileName) $ moduleRange module'
      imps' = importCtr. convertImportDecl fileName <$> imps
      decls' = convertDeclaration fileName =<< decls
      exps' = map (convertExport fileName) . toList . wrpValue <$> exps
    uncurry AST.Module ann (nameValue modName) (imps' <> decls') exps'
    where
    importCtr (a, b, c, d) = AST.ImportDeclaration a b c d
  
  ctrFields :: [N.Ident]
  ctrFields = [N.Ident ("value" <> Text.pack (show (n :: Integer))) | n <- [0..]]
  