-- | 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 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 :: forall a. Comment a -> Maybe Comment
comment = \case
  Comment Text
t
    | Text
"{-" Text -> Text -> Bool
`Text.isPrefixOf` Text
t -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Comment
C.BlockComment forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop Int
2 forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.dropEnd Int
2 Text
t
    | Text
"--" Text -> Text -> Bool
`Text.isPrefixOf` Text
t -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Comment
C.LineComment forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
Text.drop Int
2 Text
t
  Comment a
_ -> forall a. Maybe a
Nothing

comments :: [Comment a] -> [C.Comment]
comments :: forall a. [Comment a] -> [Comment]
comments = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a. Comment a -> Maybe Comment
comment

sourcePos :: SourcePos -> Pos.SourcePos
sourcePos :: SourcePos -> SourcePos
sourcePos (SourcePos Int
line Int
col) = Int -> Int -> SourcePos
Pos.SourcePos Int
line Int
col

sourceSpan :: String -> SourceRange -> Pos.SourceSpan
sourceSpan :: String -> SourceRange -> SourceSpan
sourceSpan String
name (SourceRange SourcePos
start SourcePos
end) = String -> SourcePos -> SourcePos -> SourceSpan
Pos.SourceSpan String
name (SourcePos -> SourcePos
sourcePos SourcePos
start) (SourcePos -> SourcePos
sourcePos SourcePos
end)

widenLeft :: TokenAnn -> Pos.SourceAnn -> Pos.SourceAnn
widenLeft :: TokenAnn -> SourceAnn -> SourceAnn
widenLeft TokenAnn
ann (SourceSpan
sp, [Comment]
_) =
  ( SourceSpan -> SourceSpan -> SourceSpan
Pos.widenSourceSpan (String -> SourceRange -> SourceSpan
sourceSpan (SourceSpan -> String
Pos.spanName SourceSpan
sp) forall a b. (a -> b) -> a -> b
$ TokenAnn -> SourceRange
tokRange TokenAnn
ann) SourceSpan
sp
  , forall a. [Comment a] -> [Comment]
comments forall a b. (a -> b) -> a -> b
$ TokenAnn -> [Comment LineFeed]
tokLeadingComments TokenAnn
ann
  )

sourceAnnCommented :: String -> SourceToken -> SourceToken -> Pos.SourceAnn
sourceAnnCommented :: String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName (SourceToken TokenAnn
ann1 Token
_) (SourceToken TokenAnn
ann2 Token
_) =
  ( String -> SourcePos -> SourcePos -> SourceSpan
Pos.SourceSpan String
fileName (SourcePos -> SourcePos
sourcePos forall a b. (a -> b) -> a -> b
$ SourceRange -> SourcePos
srcStart forall a b. (a -> b) -> a -> b
$ TokenAnn -> SourceRange
tokRange TokenAnn
ann1) (SourcePos -> SourcePos
sourcePos forall a b. (a -> b) -> a -> b
$ SourceRange -> SourcePos
srcEnd forall a b. (a -> b) -> a -> b
$ TokenAnn -> SourceRange
tokRange TokenAnn
ann2)
  , forall a. [Comment a] -> [Comment]
comments forall a b. (a -> b) -> a -> b
$ TokenAnn -> [Comment LineFeed]
tokLeadingComments TokenAnn
ann1
  )

sourceAnn :: String -> SourceToken -> SourceToken -> Pos.SourceAnn
sourceAnn :: String -> SourceToken -> SourceToken -> SourceAnn
sourceAnn String
fileName (SourceToken TokenAnn
ann1 Token
_) (SourceToken TokenAnn
ann2 Token
_) =
  ( String -> SourcePos -> SourcePos -> SourceSpan
Pos.SourceSpan String
fileName (SourcePos -> SourcePos
sourcePos forall a b. (a -> b) -> a -> b
$ SourceRange -> SourcePos
srcStart forall a b. (a -> b) -> a -> b
$ TokenAnn -> SourceRange
tokRange TokenAnn
ann1) (SourcePos -> SourcePos
sourcePos forall a b. (a -> b) -> a -> b
$ SourceRange -> SourcePos
srcEnd forall a b. (a -> b) -> a -> b
$ TokenAnn -> SourceRange
tokRange TokenAnn
ann2)
  , []
  )

sourceName :: String -> Name a -> Pos.SourceAnn
sourceName :: forall a. String -> Name a -> SourceAnn
sourceName String
fileName Name a
a = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName (forall a. Name a -> SourceToken
nameTok Name a
a) (forall a. Name a -> SourceToken
nameTok Name a
a)

sourceQualName :: String -> QualifiedName a -> Pos.SourceAnn
sourceQualName :: forall a. String -> QualifiedName a -> SourceAnn
sourceQualName String
fileName QualifiedName a
a = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName (forall a. QualifiedName a -> SourceToken
qualTok QualifiedName a
a) (forall a. QualifiedName a -> SourceToken
qualTok QualifiedName a
a)

moduleName :: Token -> Maybe N.ModuleName
moduleName :: Token -> Maybe ModuleName
moduleName = \case
  TokLowerName [Text]
as Text
_ -> [Text] -> Maybe ModuleName
go [Text]
as
  TokUpperName [Text]
as Text
_ -> [Text] -> Maybe ModuleName
go [Text]
as
  TokSymbolName [Text]
as Text
_ -> [Text] -> Maybe ModuleName
go [Text]
as
  TokOperator [Text]
as Text
_ -> [Text] -> Maybe ModuleName
go [Text]
as
  Token
_ -> forall a. Maybe a
Nothing
  where
  go :: [Text] -> Maybe ModuleName
go [] = forall a. Maybe a
Nothing
  go [Text]
ns = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> ModuleName
N.ModuleName forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
Text.intercalate Text
"." [Text]
ns

qualified :: QualifiedName a -> N.Qualified a
qualified :: forall a. QualifiedName a -> Qualified a
qualified QualifiedName a
q = forall a. QualifiedBy -> a -> Qualified a
N.Qualified QualifiedBy
qb (forall a. QualifiedName a -> a
qualName QualifiedName a
q)
  where
  qb :: QualifiedBy
qb = forall b a. b -> (a -> b) -> Maybe a -> b
maybe QualifiedBy
N.ByNullSourcePos ModuleName -> QualifiedBy
N.ByModuleName forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> Maybe ModuleName
qualModule QualifiedName a
q

ident :: Ident -> N.Ident
ident :: Ident -> Ident
ident = Text -> Ident
N.Ident forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
getIdent

convertType :: String -> Type a -> T.SourceType
convertType :: forall a. String -> Type a -> SourceType
convertType String
fileName = Type a -> SourceType
go
  where
  goRow :: Row a -> SourceToken -> SourceType
goRow (Row Maybe (Separated (Labeled Label (Type a)))
labels Maybe (SourceToken, Type a)
tl) SourceToken
b = do
    let
      rowTail :: SourceType
rowTail = case Maybe (SourceToken, Type a)
tl of
        Just (SourceToken
_, Type a
ty) -> Type a -> SourceType
go Type a
ty
        Maybe (SourceToken, Type a)
Nothing -> forall a. a -> Type a
T.REmpty forall a b. (a -> b) -> a -> b
$ String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
b SourceToken
b
      rowCons :: Labeled Label (Type a) -> SourceType -> SourceType
rowCons (Labeled Label
a SourceToken
_ Type a
ty) SourceType
c = do
        let ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName (Label -> SourceToken
lblTok Label
a) (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Type a -> TokenRange
typeRange Type a
ty)
        forall a. a -> Label -> Type a -> Type a -> Type a
T.RCons SourceAnn
ann (PSString -> Label
L.Label forall a b. (a -> b) -> a -> b
$ Label -> PSString
lblName Label
a) (Type a -> SourceType
go Type a
ty) SourceType
c
    case Maybe (Separated (Labeled Label (Type a)))
labels of
      Just (Separated Labeled Label (Type a)
h [(SourceToken, Labeled Label (Type a))]
t) ->
        Labeled Label (Type a) -> SourceType -> SourceType
rowCons Labeled Label (Type a)
h forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Labeled Label (Type a) -> SourceType -> SourceType
rowCons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) SourceType
rowTail [(SourceToken, Labeled Label (Type a))]
t
      Maybe (Separated (Labeled Label (Type a)))
Nothing ->
        SourceType
rowTail

  go :: Type a -> SourceType
go = \case
    TypeVar a
_ Name Ident
a ->
      forall a. a -> Text -> Type a
T.TypeVar (forall a. String -> Name a -> SourceAnn
sourceName String
fileName Name Ident
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
getIdent forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
a
    TypeConstructor a
_ QualifiedName (ProperName 'TypeName)
a ->
      forall a. a -> Qualified (ProperName 'TypeName) -> Type a
T.TypeConstructor (forall a. String -> QualifiedName a -> SourceAnn
sourceQualName String
fileName QualifiedName (ProperName 'TypeName)
a) forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> Qualified a
qualified QualifiedName (ProperName 'TypeName)
a
    TypeWildcard a
_ SourceToken
a ->
      forall a. a -> WildcardData -> Type a
T.TypeWildcard (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a) WildcardData
T.UnnamedWildcard
    TypeHole a
_ Name Ident
a ->
      forall a. a -> WildcardData -> Type a
T.TypeWildcard (forall a. String -> Name a -> SourceAnn
sourceName String
fileName Name Ident
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> WildcardData
T.HoleWildcard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
getIdent forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
a
    TypeString a
_ SourceToken
a PSString
b ->
      forall a. a -> PSString -> Type a
T.TypeLevelString (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a) PSString
b
    TypeInt a
_ Maybe SourceToken
_ SourceToken
a Integer
b ->
      forall a. a -> Integer -> Type a
T.TypeLevelInt (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a) Integer
b
    TypeRow a
_ (Wrapped SourceToken
_ Row a
row SourceToken
b) ->
      Row a -> SourceToken -> SourceType
goRow Row a
row SourceToken
b
    TypeRecord a
_ (Wrapped SourceToken
a Row a
row SourceToken
b) -> do
      let
        ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
b
        annRec :: SourceAnn
annRec = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnn String
fileName SourceToken
a SourceToken
a
      forall a. a -> Type a -> Type a -> Type a
T.TypeApp SourceAnn
ann (SourceType
Env.tyRecord forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SourceAnn
annRec) forall a b. (a -> b) -> a -> b
$ Row a -> SourceToken -> SourceType
goRow Row a
row SourceToken
b
    TypeForall a
_ SourceToken
kw NonEmpty (TypeVarBinding a)
bindings SourceToken
_ Type a
ty -> do
      let
        mkForAll :: Name Ident -> Maybe SourceType -> SourceType -> SourceType
mkForAll Name Ident
a Maybe SourceType
b SourceType
t = do
          let ann' :: SourceAnn
ann' = TokenAnn -> SourceAnn -> SourceAnn
widenLeft (SourceToken -> TokenAnn
tokAnn forall a b. (a -> b) -> a -> b
$ forall a. Name a -> SourceToken
nameTok Name Ident
a) forall a b. (a -> b) -> a -> b
$ forall a. Type a -> a
T.getAnnForType SourceType
t
          forall a.
a
-> Text -> Maybe (Type a) -> Type a -> Maybe SkolemScope -> Type a
T.ForAll SourceAnn
ann' (Ident -> Text
getIdent forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
a) Maybe SourceType
b SourceType
t forall a. Maybe a
Nothing
        k :: TypeVarBinding a -> SourceType -> SourceType
k (TypeVarKinded (Wrapped SourceToken
_ (Labeled Name Ident
a SourceToken
_ Type a
b) SourceToken
_)) = Name Ident -> Maybe SourceType -> SourceType -> SourceType
mkForAll Name Ident
a (forall a. a -> Maybe a
Just (Type a -> SourceType
go Type a
b))
        k (TypeVarName Name Ident
a) = Name Ident -> Maybe SourceType -> SourceType -> SourceType
mkForAll Name Ident
a forall a. Maybe a
Nothing
        ty' :: SourceType
ty' = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TypeVarBinding a -> SourceType -> SourceType
k (Type a -> SourceType
go Type a
ty) NonEmpty (TypeVarBinding a)
bindings
        ann :: SourceAnn
ann = TokenAnn -> SourceAnn -> SourceAnn
widenLeft (SourceToken -> TokenAnn
tokAnn SourceToken
kw) forall a b. (a -> b) -> a -> b
$ forall a. Type a -> a
T.getAnnForType SourceType
ty'
      forall a. a -> Type a -> Type a
T.setAnnForType SourceAnn
ann SourceType
ty'
    TypeKinded a
_ Type a
ty SourceToken
_ Type a
kd -> do
      let
        ty' :: SourceType
ty' = Type a -> SourceType
go Type a
ty
        kd' :: SourceType
kd' = Type a -> SourceType
go Type a
kd
        ann :: SourceAnn
ann = SourceAnn -> SourceAnn -> SourceAnn
Pos.widenSourceAnn (forall a. Type a -> a
T.getAnnForType SourceType
ty') (forall a. Type a -> a
T.getAnnForType SourceType
kd')
      forall a. a -> Type a -> Type a -> Type a
T.KindedType SourceAnn
ann SourceType
ty' SourceType
kd'
    TypeApp a
_ Type a
a Type a
b -> do
      let
        a' :: SourceType
a' = Type a -> SourceType
go Type a
a
        b' :: SourceType
b' = Type a -> SourceType
go Type a
b
        ann :: SourceAnn
ann = SourceAnn -> SourceAnn -> SourceAnn
Pos.widenSourceAnn (forall a. Type a -> a
T.getAnnForType SourceType
a') (forall a. Type a -> a
T.getAnnForType SourceType
b')
      forall a. a -> Type a -> Type a -> Type a
T.TypeApp SourceAnn
ann SourceType
a' SourceType
b'
    ty :: Type a
ty@(TypeOp a
_ Type a
_ QualifiedName (OpName 'TypeOpName)
_ Type a
_) -> do
      let
        reassoc :: QualifiedName (OpName 'TypeOpName)
-> SourceType -> Type a -> SourceType
reassoc QualifiedName (OpName 'TypeOpName)
op SourceType
b' Type a
a = do
          let
            a' :: SourceType
a'  = Type a -> SourceType
go Type a
a
            op' :: SourceType
op' = forall a. a -> Qualified (OpName 'TypeOpName) -> Type a
T.TypeOp (forall a. String -> QualifiedName a -> SourceAnn
sourceQualName String
fileName QualifiedName (OpName 'TypeOpName)
op) forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> Qualified a
qualified QualifiedName (OpName 'TypeOpName)
op
            ann :: SourceAnn
ann = SourceAnn -> SourceAnn -> SourceAnn
Pos.widenSourceAnn (forall a. Type a -> a
T.getAnnForType SourceType
a') (forall a. Type a -> a
T.getAnnForType SourceType
b')
          forall a. a -> Type a -> Type a -> Type a -> Type a
T.BinaryNoParensType SourceAnn
ann SourceType
op' (Type a -> SourceType
go Type a
a) SourceType
b'
        loop :: (Type a -> SourceType) -> Type a -> SourceType
loop Type a -> SourceType
k = \case
          TypeOp a
_ Type a
a QualifiedName (OpName 'TypeOpName)
op Type a
b -> (Type a -> SourceType) -> Type a -> SourceType
loop (QualifiedName (OpName 'TypeOpName)
-> SourceType -> Type a -> SourceType
reassoc QualifiedName (OpName 'TypeOpName)
op (Type a -> SourceType
k Type a
b)) Type a
a
          Type a
expr' -> Type a -> SourceType
k Type a
expr'
      (Type a -> SourceType) -> Type a -> SourceType
loop Type a -> SourceType
go Type a
ty
    TypeOpName a
_ QualifiedName (OpName 'TypeOpName)
op -> do
      let rng :: TokenRange
rng = forall a. QualifiedName a -> TokenRange
qualRange QualifiedName (OpName 'TypeOpName)
op
      forall a. a -> Qualified (OpName 'TypeOpName) -> Type a
T.TypeOp (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) TokenRange
rng) (forall a. QualifiedName a -> Qualified a
qualified QualifiedName (OpName 'TypeOpName)
op)
    TypeArr a
_ Type a
a SourceToken
arr Type a
b -> do
      let
        a' :: SourceType
a' = Type a -> SourceType
go Type a
a
        b' :: SourceType
b' = Type a -> SourceType
go Type a
b
        arr' :: SourceType
arr' = SourceType
Env.tyFunction forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
arr SourceToken
arr
        ann :: SourceAnn
ann = SourceAnn -> SourceAnn -> SourceAnn
Pos.widenSourceAnn (forall a. Type a -> a
T.getAnnForType SourceType
a') (forall a. Type a -> a
T.getAnnForType SourceType
b')
      forall a. a -> Type a -> Type a -> Type a
T.TypeApp SourceAnn
ann (forall a. a -> Type a -> Type a -> Type a
T.TypeApp SourceAnn
ann SourceType
arr' SourceType
a') SourceType
b'
    TypeArrName a
_ SourceToken
a ->
      SourceType
Env.tyFunction forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a
    TypeConstrained a
_ Constraint a
a SourceToken
_ Type a
b -> do
      let
        a' :: SourceConstraint
a' = forall a. String -> Constraint a -> SourceConstraint
convertConstraint String
fileName Constraint a
a
        b' :: SourceType
b' = Type a -> SourceType
go Type a
b
        ann :: SourceAnn
ann = SourceAnn -> SourceAnn -> SourceAnn
Pos.widenSourceAnn (forall a. Constraint a -> a
T.constraintAnn SourceConstraint
a') (forall a. Type a -> a
T.getAnnForType SourceType
b')
      forall a. a -> Constraint a -> Type a -> Type a
T.ConstrainedType SourceAnn
ann SourceConstraint
a' SourceType
b'
    TypeParens a
_ (Wrapped SourceToken
a Type a
ty SourceToken
b) ->
      forall a. a -> Type a -> Type a
T.ParensInType (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
b) forall a b. (a -> b) -> a -> b
$ Type a -> SourceType
go Type a
ty
    ty :: Type a
ty@(TypeUnaryRow a
_ SourceToken
_ Type a
a) -> do
      let
        a' :: SourceType
a' = Type a -> SourceType
go Type a
a
        rng :: TokenRange
rng = forall a. Type a -> TokenRange
typeRange Type a
ty
        ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) TokenRange
rng
      forall a. a -> Type a -> Type a
T.setAnnForType SourceAnn
ann forall a b. (a -> b) -> a -> b
$ SourceType -> SourceType
Env.kindRow SourceType
a'

convertConstraint :: String -> Constraint a -> T.SourceConstraint
convertConstraint :: forall a. String -> Constraint a -> SourceConstraint
convertConstraint String
fileName = Constraint a -> SourceConstraint
go
  where
  go :: Constraint a -> SourceConstraint
go = \case
    cst :: Constraint a
cst@(Constraint a
_ QualifiedName (ProperName 'ClassName)
name [Type a]
args) -> do
      let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Constraint a -> TokenRange
constraintRange Constraint a
cst
      forall a.
a
-> Qualified (ProperName 'ClassName)
-> [Type a]
-> [Type a]
-> Maybe ConstraintData
-> Constraint a
T.Constraint SourceAnn
ann (forall a. QualifiedName a -> Qualified a
qualified QualifiedName (ProperName 'ClassName)
name) [] (forall a. String -> Type a -> SourceType
convertType String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type a]
args) forall a. Maybe a
Nothing
    ConstraintParens a
_ (Wrapped SourceToken
_ Constraint a
c SourceToken
_) -> Constraint a -> SourceConstraint
go Constraint a
c

convertGuarded :: String -> Guarded a -> [AST.GuardedExpr]
convertGuarded :: forall a. String -> Guarded a -> [GuardedExpr]
convertGuarded String
fileName = \case
  Unconditional SourceToken
_ Where a
x -> [[Guard] -> Expr -> GuardedExpr
AST.GuardedExpr [] (forall a. String -> Where a -> Expr
convertWhere String
fileName Where a
x)]
  Guarded NonEmpty (GuardedExpr a)
gs -> (\(GuardedExpr SourceToken
_ Separated (PatternGuard a)
ps SourceToken
_ Where a
x) -> [Guard] -> Expr -> GuardedExpr
AST.GuardedExpr (PatternGuard a -> Guard
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Separated (PatternGuard a)
ps) (forall a. String -> Where a -> Expr
convertWhere String
fileName Where a
x)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty (GuardedExpr a)
gs
  where
  go :: Expr a -> Expr
go = forall a. String -> Expr a -> Expr
convertExpr String
fileName
  p :: PatternGuard a -> Guard
p (PatternGuard Maybe (Binder a, SourceToken)
Nothing Expr a
x) = Expr -> Guard
AST.ConditionGuard (Expr a -> Expr
go Expr a
x)
  p (PatternGuard (Just (Binder a
b, SourceToken
_)) Expr a
x) = Binder -> Expr -> Guard
AST.PatternGuard (forall a. String -> Binder a -> Binder
convertBinder String
fileName Binder a
b) (Expr a -> Expr
go Expr a
x)

convertWhere :: String -> Where a -> AST.Expr
convertWhere :: forall a. String -> Where a -> Expr
convertWhere String
fileName = \case
  Where Expr a
expr Maybe (SourceToken, NonEmpty (LetBinding a))
Nothing -> forall a. String -> Expr a -> Expr
convertExpr String
fileName Expr a
expr
  Where Expr a
expr (Just (SourceToken
_, NonEmpty (LetBinding a)
bs)) -> do
    let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr
    forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SourceSpan -> [Comment] -> Expr -> Expr
AST.PositionedValue SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. WhereProvenance -> [Declaration] -> Expr -> Expr
AST.Let WhereProvenance
AST.FromWhere (forall a. String -> LetBinding a -> Declaration
convertLetBinding String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LetBinding a)
bs) forall a b. (a -> b) -> a -> b
$ forall a. String -> Expr a -> Expr
convertExpr String
fileName Expr a
expr

convertLetBinding :: String -> LetBinding a -> AST.Declaration
convertLetBinding :: forall a. String -> LetBinding a -> Declaration
convertLetBinding String
fileName = \case
  LetBindingSignature a
_ Labeled (Name Ident) (Type a)
lbl ->
    forall a. String -> Labeled (Name Ident) (Type a) -> Declaration
convertSignature String
fileName Labeled (Name Ident) (Type a)
lbl
  binding :: LetBinding a
binding@(LetBindingName a
_ ValueBindingFields a
fields) -> do
    let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. LetBinding a -> TokenRange
letBindingRange LetBinding a
binding
    forall a.
String -> SourceAnn -> ValueBindingFields a -> Declaration
convertValueBindingFields String
fileName SourceAnn
ann ValueBindingFields a
fields
  binding :: LetBinding a
binding@(LetBindingPattern a
_ Binder a
a SourceToken
_ Where a
b) -> do
    let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. LetBinding a -> TokenRange
letBindingRange LetBinding a
binding
    SourceAnn -> Binder -> Expr -> Declaration
AST.BoundValueDeclaration SourceAnn
ann (forall a. String -> Binder a -> Binder
convertBinder String
fileName Binder a
a) (forall a. String -> Where a -> Expr
convertWhere String
fileName Where a
b)

convertExpr :: forall a. String -> Expr a -> AST.Expr
convertExpr :: forall a. String -> Expr a -> Expr
convertExpr String
fileName = Expr a -> Expr
go
  where
  positioned :: SourceAnn -> Expr -> Expr
positioned =
    forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SourceSpan -> [Comment] -> Expr -> Expr
AST.PositionedValue

  goDoStatement :: DoStatement a -> DoNotationElement
goDoStatement = \case
    stmt :: DoStatement a
stmt@(DoLet SourceToken
_ NonEmpty (LetBinding a)
as) -> do
      let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. DoStatement a -> TokenRange
doStatementRange DoStatement a
stmt
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SourceSpan -> [Comment] -> DoNotationElement -> DoNotationElement
AST.PositionedDoNotationElement SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Declaration] -> DoNotationElement
AST.DoNotationLet forall a b. (a -> b) -> a -> b
$ forall a. String -> LetBinding a -> Declaration
convertLetBinding String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LetBinding a)
as
    stmt :: DoStatement a
stmt@(DoDiscard Expr a
a) -> do
      let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnn String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. DoStatement a -> TokenRange
doStatementRange DoStatement a
stmt
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SourceSpan -> [Comment] -> DoNotationElement -> DoNotationElement
AST.PositionedDoNotationElement SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> DoNotationElement
AST.DoNotationValue forall a b. (a -> b) -> a -> b
$ Expr a -> Expr
go Expr a
a
    stmt :: DoStatement a
stmt@(DoBind Binder a
a SourceToken
_ Expr a
b) -> do
      let
        ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnn String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. DoStatement a -> TokenRange
doStatementRange DoStatement a
stmt
        a' :: Binder
a' = forall a. String -> Binder a -> Binder
convertBinder String
fileName Binder a
a
        b' :: Expr
b' = Expr a -> Expr
go Expr a
b
      forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SourceSpan -> [Comment] -> DoNotationElement -> DoNotationElement
AST.PositionedDoNotationElement SourceAnn
ann forall a b. (a -> b) -> a -> b
$ Binder -> Expr -> DoNotationElement
AST.DoNotationBind Binder
a' Expr
b'

  go :: Expr a -> Expr
go = \case
    ExprHole a
_ Name Ident
a ->
      SourceAnn -> Expr -> Expr
positioned (forall a. String -> Name a -> SourceAnn
sourceName String
fileName Name Ident
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Expr
AST.Hole forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
getIdent forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
a
    ExprSection a
_ SourceToken
a ->
      SourceAnn -> Expr -> Expr
positioned (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a) Expr
AST.AnonymousArgument
    ExprIdent a
_ QualifiedName Ident
a -> do
      let ann :: SourceAnn
ann = forall a. String -> QualifiedName a -> SourceAnn
sourceQualName String
fileName QualifiedName Ident
a
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Qualified Ident -> Expr
AST.Var (forall a b. (a, b) -> a
fst SourceAnn
ann) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. QualifiedName a -> Qualified a
qualified forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ident -> Ident
ident QualifiedName Ident
a
    ExprConstructor a
_ QualifiedName (ProperName 'ConstructorName)
a -> do
      let ann :: SourceAnn
ann = forall a. String -> QualifiedName a -> SourceAnn
sourceQualName String
fileName QualifiedName (ProperName 'ConstructorName)
a
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Qualified (ProperName 'ConstructorName) -> Expr
AST.Constructor (forall a b. (a, b) -> a
fst SourceAnn
ann) forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> Qualified a
qualified QualifiedName (ProperName 'ConstructorName)
a
    ExprBoolean a
_ SourceToken
a Bool
b -> do
      let ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Literal Expr -> Expr
AST.Literal (forall a b. (a, b) -> a
fst SourceAnn
ann) forall a b. (a -> b) -> a -> b
$ forall a. Bool -> Literal a
AST.BooleanLiteral Bool
b
    ExprChar a
_ SourceToken
a Char
b -> do
      let ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Literal Expr -> Expr
AST.Literal (forall a b. (a, b) -> a
fst SourceAnn
ann) forall a b. (a -> b) -> a -> b
$ forall a. Char -> Literal a
AST.CharLiteral Char
b
    ExprString a
_ SourceToken
a PSString
b -> do
      let ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Literal Expr -> Expr
AST.Literal (forall a b. (a, b) -> a
fst SourceAnn
ann) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PSString -> Literal a
AST.StringLiteral forall a b. (a -> b) -> a -> b
$ PSString
b
    ExprNumber a
_ SourceToken
a Either Integer Double
b -> do
      let ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Literal Expr -> Expr
AST.Literal (forall a b. (a, b) -> a
fst SourceAnn
ann) forall a b. (a -> b) -> a -> b
$ forall a. Either Integer Double -> Literal a
AST.NumericLiteral Either Integer Double
b
    ExprArray a
_ (Wrapped SourceToken
a Maybe (Separated (Expr a))
bs SourceToken
c) -> do
      let
        ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
c
        vals :: [Expr]
vals = case Maybe (Separated (Expr a))
bs of
          Just (Separated Expr a
x [(SourceToken, Expr a)]
xs) -> Expr a -> Expr
go Expr a
x forall a. a -> [a] -> [a]
: (Expr a -> Expr
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceToken, Expr a)]
xs)
          Maybe (Separated (Expr a))
Nothing -> []
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Literal Expr -> Expr
AST.Literal (forall a b. (a, b) -> a
fst SourceAnn
ann) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Literal a
AST.ArrayLiteral [Expr]
vals
    ExprRecord a
z (Wrapped SourceToken
a Maybe (Separated (RecordLabeled (Expr a)))
bs SourceToken
c) -> do
      let
        ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
c
        lbl :: RecordLabeled (Expr a) -> (PSString, Expr)
lbl = \case
          RecordPun Name Ident
f -> (Text -> PSString
mkString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
getIdent forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
f, Expr a -> Expr
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> QualifiedName Ident -> Expr a
ExprIdent a
z forall a b. (a -> b) -> a -> b
$ forall a. SourceToken -> Maybe ModuleName -> a -> QualifiedName a
QualifiedName (forall a. Name a -> SourceToken
nameTok Name Ident
f) forall a. Maybe a
Nothing (forall a. Name a -> a
nameValue Name Ident
f))
          RecordField Label
f SourceToken
_ Expr a
v -> (Label -> PSString
lblName Label
f, Expr a -> Expr
go Expr a
v)
        vals :: [(PSString, Expr)]
vals = case Maybe (Separated (RecordLabeled (Expr a)))
bs of
          Just (Separated RecordLabeled (Expr a)
x [(SourceToken, RecordLabeled (Expr a))]
xs) -> RecordLabeled (Expr a) -> (PSString, Expr)
lbl RecordLabeled (Expr a)
x forall a. a -> [a] -> [a]
: (RecordLabeled (Expr a) -> (PSString, Expr)
lbl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceToken, RecordLabeled (Expr a))]
xs)
          Maybe (Separated (RecordLabeled (Expr a)))
Nothing -> []
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Literal Expr -> Expr
AST.Literal (forall a b. (a, b) -> a
fst SourceAnn
ann) forall a b. (a -> b) -> a -> b
$ forall a. [(PSString, a)] -> Literal a
AST.ObjectLiteral [(PSString, Expr)]
vals
    ExprParens a
_ (Wrapped SourceToken
a Expr a
b SourceToken
c) ->
      SourceAnn -> Expr -> Expr
positioned (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
AST.Parens forall a b. (a -> b) -> a -> b
$ Expr a -> Expr
go Expr a
b
    expr :: Expr a
expr@(ExprTyped a
_ Expr a
a SourceToken
_ Type a
b) -> do
      let
        a' :: Expr
a' = Expr a -> Expr
go Expr a
a
        b' :: SourceType
b' = forall a. String -> Type a -> SourceType
convertType String
fileName Type a
b
        ann :: SourceAnn
ann = (String -> SourceRange -> SourceSpan
sourceSpan String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenRange -> SourceRange
toSourceRange forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr, [])
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall a b. (a -> b) -> a -> b
$ Bool -> Expr -> SourceType -> Expr
AST.TypedValue Bool
True Expr
a' SourceType
b'
    expr :: Expr a
expr@(ExprInfix a
_ Expr a
a (Wrapped SourceToken
_ Expr a
b SourceToken
_) Expr a
c) -> do
      let ann :: SourceAnn
ann = (String -> SourceRange -> SourceSpan
sourceSpan String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenRange -> SourceRange
toSourceRange forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr, [])
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr -> Expr
AST.BinaryNoParens (Expr a -> Expr
go Expr a
b) (Expr a -> Expr
go Expr a
a) (Expr a -> Expr
go Expr a
c)
    expr :: Expr a
expr@(ExprOp a
_ Expr a
_ QualifiedName (OpName 'ValueOpName)
_ Expr a
_) -> do
      let
        ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnn String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr
        reassoc :: QualifiedName (OpName 'ValueOpName) -> Expr -> Expr a -> Expr
reassoc QualifiedName (OpName 'ValueOpName)
op Expr
b Expr a
a = do
          let op' :: Expr
op' = SourceSpan -> Qualified (OpName 'ValueOpName) -> Expr
AST.Op (String -> SourceRange -> SourceSpan
sourceSpan String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenRange -> SourceRange
toSourceRange forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> TokenRange
qualRange QualifiedName (OpName 'ValueOpName)
op) forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> Qualified a
qualified QualifiedName (OpName 'ValueOpName)
op
          Expr -> Expr -> Expr -> Expr
AST.BinaryNoParens Expr
op' (Expr a -> Expr
go Expr a
a) Expr
b
        loop :: (Expr a -> Expr) -> Expr a -> Expr
loop Expr a -> Expr
k = \case
          ExprOp a
_ Expr a
a QualifiedName (OpName 'ValueOpName)
op Expr a
b -> (Expr a -> Expr) -> Expr a -> Expr
loop (QualifiedName (OpName 'ValueOpName) -> Expr -> Expr a -> Expr
reassoc QualifiedName (OpName 'ValueOpName)
op (Expr a -> Expr
k Expr a
b)) Expr a
a
          Expr a
expr' -> Expr a -> Expr
k Expr a
expr'
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall a b. (a -> b) -> a -> b
$ (Expr a -> Expr) -> Expr a -> Expr
loop Expr a -> Expr
go Expr a
expr
    ExprOpName a
_ QualifiedName (OpName 'ValueOpName)
op -> do
      let
        rng :: TokenRange
rng = forall a. QualifiedName a -> TokenRange
qualRange QualifiedName (OpName 'ValueOpName)
op
        op' :: Expr
op' = SourceSpan -> Qualified (OpName 'ValueOpName) -> Expr
AST.Op (String -> SourceRange -> SourceSpan
sourceSpan String
fileName forall a b. (a -> b) -> a -> b
$ TokenRange -> SourceRange
toSourceRange TokenRange
rng) forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> Qualified a
qualified QualifiedName (OpName 'ValueOpName)
op
      SourceAnn -> Expr -> Expr
positioned (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) TokenRange
rng) Expr
op'
    expr :: Expr a
expr@(ExprNegate a
_ SourceToken
_ Expr a
b) -> do
      let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Expr -> Expr
AST.UnaryMinus (forall a b. (a, b) -> a
fst SourceAnn
ann) forall a b. (a -> b) -> a -> b
$ Expr a -> Expr
go Expr a
b
    expr :: Expr a
expr@(ExprRecordAccessor a
_ (RecordAccessor Expr a
a SourceToken
_ (Separated Label
h [(SourceToken, Label)]
t))) -> do
      let
        ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr
        field :: Expr -> Label -> Expr
field Expr
x Label
f = PSString -> Expr -> Expr
AST.Accessor (Label -> PSString
lblName Label
f) Expr
x
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Expr
x (SourceToken
_, Label
f) -> Expr -> Label -> Expr
field Expr
x Label
f) (Expr -> Label -> Expr
field (Expr a -> Expr
go Expr a
a) Label
h) [(SourceToken, Label)]
t
    expr :: Expr a
expr@(ExprRecordUpdate a
_ Expr a
a DelimitedNonEmpty (RecordUpdate a)
b) -> do
      let
        ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr
        k :: RecordUpdate a -> (PSString, PathNode Expr)
k (RecordUpdateLeaf Label
f SourceToken
_ Expr a
x) = (Label -> PSString
lblName Label
f, forall t. t -> PathNode t
AST.Leaf forall a b. (a -> b) -> a -> b
$ Expr a -> Expr
go Expr a
x)
        k (RecordUpdateBranch Label
f DelimitedNonEmpty (RecordUpdate a)
xs) = (Label -> PSString
lblName Label
f, forall t. PathTree t -> PathNode t
AST.Branch forall a b. (a -> b) -> a -> b
$ DelimitedNonEmpty (RecordUpdate a) -> PathTree Expr
toTree DelimitedNonEmpty (RecordUpdate a)
xs)
        toTree :: DelimitedNonEmpty (RecordUpdate a) -> PathTree Expr
toTree (Wrapped SourceToken
_ Separated (RecordUpdate a)
xs SourceToken
_) = forall t. AssocList PSString (PathNode t) -> PathTree t
AST.PathTree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k t. [(k, t)] -> AssocList k t
AST.AssocList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map RecordUpdate a -> (PSString, PathNode Expr)
k forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Separated (RecordUpdate a)
xs
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> PathTree Expr -> Expr
AST.ObjectUpdateNested (Expr a -> Expr
go Expr a
a) forall a b. (a -> b) -> a -> b
$ DelimitedNonEmpty (RecordUpdate a) -> PathTree Expr
toTree DelimitedNonEmpty (RecordUpdate a)
b
    expr :: Expr a
expr@(ExprApp a
_ Expr a
a Expr a
b) -> do
      let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnn String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr
AST.App (Expr a -> Expr
go Expr a
a) (Expr a -> Expr
go Expr a
b)
    expr :: Expr a
expr@(ExprLambda a
_ (Lambda SourceToken
_ NonEmpty (Binder a)
as SourceToken
_ Expr a
b)) -> do
      let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binder -> Expr -> Expr
AST.Abs (forall a. String -> Binder a -> Binder
convertBinder String
fileName (forall a. NonEmpty a -> a
NE.head NonEmpty (Binder a)
as))
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Binder -> Expr -> Expr
AST.Abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> Binder a -> Binder
convertBinder String
fileName) (Expr a -> Expr
go Expr a
b)
        forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.tail NonEmpty (Binder a)
as
    expr :: Expr a
expr@(ExprIf a
_ (IfThenElse SourceToken
_ Expr a
a SourceToken
_ Expr a
b SourceToken
_ Expr a
c)) -> do
      let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr -> Expr
AST.IfThenElse (Expr a -> Expr
go Expr a
a) (Expr a -> Expr
go Expr a
b) (Expr a -> Expr
go Expr a
c)
    expr :: Expr a
expr@(ExprCase a
_ (CaseOf SourceToken
_ Separated (Expr a)
as SourceToken
_ NonEmpty (Separated (Binder a), Guarded a)
bs)) -> do
      let
        ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr
        as' :: [Expr]
as' = Expr a -> Expr
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Separated (Expr a)
as
        bs' :: [CaseAlternative]
bs' = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Binder] -> [GuardedExpr] -> CaseAlternative
AST.CaseAlternative forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a b. (a -> b) -> [a] -> [b]
map (forall a. String -> Binder a -> Binder
convertBinder String
fileName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList) (forall a. String -> Guarded a -> [GuardedExpr]
convertGuarded String
fileName) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Separated (Binder a), Guarded a)
bs
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall a b. (a -> b) -> a -> b
$ [Expr] -> [CaseAlternative] -> Expr
AST.Case [Expr]
as' [CaseAlternative]
bs'
    expr :: Expr a
expr@(ExprLet a
_ (LetIn SourceToken
_ NonEmpty (LetBinding a)
as SourceToken
_ Expr a
b)) -> do
      let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. WhereProvenance -> [Declaration] -> Expr -> Expr
AST.Let WhereProvenance
AST.FromLet (forall a. String -> LetBinding a -> Declaration
convertLetBinding String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty (LetBinding a)
as) forall a b. (a -> b) -> a -> b
$ Expr a -> Expr
go Expr a
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 :: Expr a
expr@(ExprDo a
_ (DoBlock SourceToken
kw NonEmpty (DoStatement a)
stmts)) -> do
      let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ModuleName -> [DoNotationElement] -> Expr
AST.Do (Token -> Maybe ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ SourceToken -> Token
tokValue SourceToken
kw) forall a b. (a -> b) -> a -> b
$ DoStatement a -> DoNotationElement
goDoStatement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty (DoStatement a)
stmts
    expr :: Expr a
expr@(ExprAdo a
_ (AdoBlock SourceToken
kw [DoStatement a]
stms SourceToken
_ Expr a
a)) -> do
      let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Expr a -> TokenRange
exprRange Expr a
expr
      SourceAnn -> Expr -> Expr
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ModuleName -> [DoNotationElement] -> Expr -> Expr
AST.Ado (Token -> Maybe ModuleName
moduleName forall a b. (a -> b) -> a -> b
$ SourceToken -> Token
tokValue SourceToken
kw) (DoStatement a -> DoNotationElement
goDoStatement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DoStatement a]
stms) forall a b. (a -> b) -> a -> b
$ Expr a -> Expr
go Expr a
a

convertBinder :: String -> Binder a -> AST.Binder
convertBinder :: forall a. String -> Binder a -> Binder
convertBinder String
fileName = Binder a -> Binder
go
  where
  positioned :: SourceAnn -> Binder -> Binder
positioned =
    forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SourceSpan -> [Comment] -> Binder -> Binder
AST.PositionedBinder

  go :: Binder a -> Binder
go = \case
    BinderWildcard a
_ SourceToken
a ->
      SourceAnn -> Binder -> Binder
positioned (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a) Binder
AST.NullBinder
    BinderVar a
_ Name Ident
a -> do
      let ann :: SourceAnn
ann = forall a. String -> Name a -> SourceAnn
sourceName String
fileName Name Ident
a
      SourceAnn -> Binder -> Binder
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Ident -> Binder
AST.VarBinder (forall a b. (a, b) -> a
fst SourceAnn
ann) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Ident
ident forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
a
    binder :: Binder a
binder@(BinderNamed a
_ Name Ident
a SourceToken
_ Binder a
b) -> do
      let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Binder a -> TokenRange
binderRange Binder a
binder
      SourceAnn -> Binder -> Binder
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Ident -> Binder -> Binder
AST.NamedBinder (forall a b. (a, b) -> a
fst SourceAnn
ann) (Ident -> Ident
ident forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
a) forall a b. (a -> b) -> a -> b
$ Binder a -> Binder
go Binder a
b
    binder :: Binder a
binder@(BinderConstructor a
_ QualifiedName (ProperName 'ConstructorName)
a [Binder a]
bs) -> do
      let ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Binder a -> TokenRange
binderRange Binder a
binder
      SourceAnn -> Binder -> Binder
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan
-> Qualified (ProperName 'ConstructorName) -> [Binder] -> Binder
AST.ConstructorBinder (forall a b. (a, b) -> a
fst SourceAnn
ann) (forall a. QualifiedName a -> Qualified a
qualified QualifiedName (ProperName 'ConstructorName)
a) forall a b. (a -> b) -> a -> b
$ Binder a -> Binder
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Binder a]
bs
    BinderBoolean a
_ SourceToken
a Bool
b -> do
      let ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a
      SourceAnn -> Binder -> Binder
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Literal Binder -> Binder
AST.LiteralBinder (forall a b. (a, b) -> a
fst SourceAnn
ann) forall a b. (a -> b) -> a -> b
$ forall a. Bool -> Literal a
AST.BooleanLiteral Bool
b
    BinderChar a
_ SourceToken
a Char
b -> do
      let ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a
      SourceAnn -> Binder -> Binder
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Literal Binder -> Binder
AST.LiteralBinder (forall a b. (a, b) -> a
fst SourceAnn
ann) forall a b. (a -> b) -> a -> b
$ forall a. Char -> Literal a
AST.CharLiteral Char
b
    BinderString a
_ SourceToken
a PSString
b -> do
      let ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a
      SourceAnn -> Binder -> Binder
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Literal Binder -> Binder
AST.LiteralBinder (forall a b. (a, b) -> a
fst SourceAnn
ann) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PSString -> Literal a
AST.StringLiteral forall a b. (a -> b) -> a -> b
$ PSString
b
    BinderNumber a
_ Maybe SourceToken
n SourceToken
a Either Integer Double
b -> do
      let
        ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
a
        b' :: Either Integer Double
b'
          | forall a. Maybe a -> Bool
isJust Maybe SourceToken
n = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. Num a => a -> a
negate forall a. Num a => a -> a
negate Either Integer Double
b
          | Bool
otherwise = Either Integer Double
b
      SourceAnn -> Binder -> Binder
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Literal Binder -> Binder
AST.LiteralBinder (forall a b. (a, b) -> a
fst SourceAnn
ann) forall a b. (a -> b) -> a -> b
$ forall a. Either Integer Double -> Literal a
AST.NumericLiteral Either Integer Double
b'
    BinderArray a
_ (Wrapped SourceToken
a Maybe (Separated (Binder a))
bs SourceToken
c) -> do
      let
        ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
c
        vals :: [Binder]
vals = case Maybe (Separated (Binder a))
bs of
          Just (Separated Binder a
x [(SourceToken, Binder a)]
xs) -> Binder a -> Binder
go Binder a
x forall a. a -> [a] -> [a]
: (Binder a -> Binder
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceToken, Binder a)]
xs)
          Maybe (Separated (Binder a))
Nothing -> []
      SourceAnn -> Binder -> Binder
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Literal Binder -> Binder
AST.LiteralBinder (forall a b. (a, b) -> a
fst SourceAnn
ann) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Literal a
AST.ArrayLiteral [Binder]
vals
    BinderRecord a
z (Wrapped SourceToken
a Maybe (Separated (RecordLabeled (Binder a)))
bs SourceToken
c) -> do
      let
        ann :: SourceAnn
ann = String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
c
        lbl :: RecordLabeled (Binder a) -> (PSString, Binder)
lbl = \case
          RecordPun Name Ident
f -> (Text -> PSString
mkString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
getIdent forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
f, Binder a -> Binder
go forall a b. (a -> b) -> a -> b
$ forall a. a -> Name Ident -> Binder a
BinderVar a
z Name Ident
f)
          RecordField Label
f SourceToken
_ Binder a
v -> (Label -> PSString
lblName Label
f, Binder a -> Binder
go Binder a
v)
        vals :: [(PSString, Binder)]
vals = case Maybe (Separated (RecordLabeled (Binder a)))
bs of
          Just (Separated RecordLabeled (Binder a)
x [(SourceToken, RecordLabeled (Binder a))]
xs) -> RecordLabeled (Binder a) -> (PSString, Binder)
lbl RecordLabeled (Binder a)
x forall a. a -> [a] -> [a]
: (RecordLabeled (Binder a) -> (PSString, Binder)
lbl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(SourceToken, RecordLabeled (Binder a))]
xs)
          Maybe (Separated (RecordLabeled (Binder a)))
Nothing -> []
      SourceAnn -> Binder -> Binder
positioned SourceAnn
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceSpan -> Literal Binder -> Binder
AST.LiteralBinder (forall a b. (a, b) -> a
fst SourceAnn
ann) forall a b. (a -> b) -> a -> b
$ forall a. [(PSString, a)] -> Literal a
AST.ObjectLiteral [(PSString, Binder)]
vals
    BinderParens a
_ (Wrapped SourceToken
a Binder a
b SourceToken
c) ->
      SourceAnn -> Binder -> Binder
positioned (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
a SourceToken
c) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Binder -> Binder
AST.ParensInBinder forall a b. (a -> b) -> a -> b
$ Binder a -> Binder
go Binder a
b
    binder :: Binder a
binder@(BinderTyped a
_ Binder a
a SourceToken
_ Type a
b) -> do
      let
        a' :: Binder
a' = Binder a -> Binder
go Binder a
a
        b' :: SourceType
b' = forall a. String -> Type a -> SourceType
convertType String
fileName Type a
b
        ann :: SourceAnn
ann = (String -> SourceRange -> SourceSpan
sourceSpan String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenRange -> SourceRange
toSourceRange forall a b. (a -> b) -> a -> b
$ forall a. Binder a -> TokenRange
binderRange Binder a
binder, [])
      SourceAnn -> Binder -> Binder
positioned SourceAnn
ann forall a b. (a -> b) -> a -> b
$ SourceType -> Binder -> Binder
AST.TypedBinder SourceType
b' Binder
a'
    binder :: Binder a
binder@(BinderOp a
_ Binder a
_ QualifiedName (OpName 'ValueOpName)
_ Binder a
_) -> do
      let
        ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnn String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Binder a -> TokenRange
binderRange Binder a
binder
        reassoc :: QualifiedName (OpName 'ValueOpName) -> Binder -> Binder a -> Binder
reassoc QualifiedName (OpName 'ValueOpName)
op Binder
b Binder a
a = do
          let op' :: Binder
op' = SourceSpan -> Qualified (OpName 'ValueOpName) -> Binder
AST.OpBinder (String -> SourceRange -> SourceSpan
sourceSpan String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenRange -> SourceRange
toSourceRange forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> TokenRange
qualRange QualifiedName (OpName 'ValueOpName)
op) forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> Qualified a
qualified QualifiedName (OpName 'ValueOpName)
op
          Binder -> Binder -> Binder -> Binder
AST.BinaryNoParensBinder Binder
op' (Binder a -> Binder
go Binder a
a) Binder
b
        loop :: (Binder a -> Binder) -> Binder a -> Binder
loop Binder a -> Binder
k = \case
          BinderOp a
_ Binder a
a QualifiedName (OpName 'ValueOpName)
op Binder a
b -> (Binder a -> Binder) -> Binder a -> Binder
loop (QualifiedName (OpName 'ValueOpName) -> Binder -> Binder a -> Binder
reassoc QualifiedName (OpName 'ValueOpName)
op (Binder a -> Binder
k Binder a
b)) Binder a
a
          Binder a
binder' -> Binder a -> Binder
k Binder a
binder'
      SourceAnn -> Binder -> Binder
positioned SourceAnn
ann forall a b. (a -> b) -> a -> b
$ (Binder a -> Binder) -> Binder a -> Binder
loop Binder a -> Binder
go Binder a
binder

convertDeclaration :: String -> Declaration a -> [AST.Declaration]
convertDeclaration :: forall a. String -> Declaration a -> [Declaration]
convertDeclaration String
fileName Declaration a
decl = case Declaration a
decl of
  DeclData a
_ (DataHead SourceToken
_ Name (ProperName 'TypeName)
a [TypeVarBinding a]
vars) Maybe (SourceToken, Separated (DataCtor a))
bd -> do
    let
      ctrs :: SourceToken -> DataCtor a -> [(SourceToken, DataCtor a)] -> [AST.DataConstructorDeclaration]
      ctrs :: forall a.
SourceToken
-> DataCtor a
-> [(SourceToken, DataCtor a)]
-> [DataConstructorDeclaration]
ctrs SourceToken
st (DataCtor a
_ Name (ProperName 'ConstructorName)
name [Type a]
fields) [(SourceToken, DataCtor a)]
tl
        = SourceAnn
-> ProperName 'ConstructorName
-> [(Ident, SourceType)]
-> DataConstructorDeclaration
AST.DataConstructorDeclaration (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
st (forall a. Name a -> SourceToken
nameTok Name (ProperName 'ConstructorName)
name)) (forall a. Name a -> a
nameValue Name (ProperName 'ConstructorName)
name) (forall a b. [a] -> [b] -> [(a, b)]
zip [Ident]
ctrFields forall a b. (a -> b) -> a -> b
$ forall a. String -> Type a -> SourceType
convertType String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type a]
fields)
        forall a. a -> [a] -> [a]
: (case [(SourceToken, DataCtor a)]
tl of
            [] -> []
            (SourceToken
st', DataCtor a
ctor) : [(SourceToken, DataCtor a)]
tl' -> forall a.
SourceToken
-> DataCtor a
-> [(SourceToken, DataCtor a)]
-> [DataConstructorDeclaration]
ctrs SourceToken
st' DataCtor a
ctor [(SourceToken, DataCtor a)]
tl'
          )
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SourceAnn
-> DataDeclType
-> ProperName 'TypeName
-> [(Text, Maybe SourceType)]
-> [DataConstructorDeclaration]
-> Declaration
AST.DataDeclaration SourceAnn
ann DataDeclType
Env.Data (forall a. Name a -> a
nameValue Name (ProperName 'TypeName)
a) (TypeVarBinding a -> (Text, Maybe SourceType)
goTypeVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding a]
vars) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(SourceToken
st, Separated DataCtor a
hd [(SourceToken, DataCtor a)]
tl) -> forall a.
SourceToken
-> DataCtor a
-> [(SourceToken, DataCtor a)]
-> [DataConstructorDeclaration]
ctrs SourceToken
st DataCtor a
hd [(SourceToken, DataCtor a)]
tl) Maybe (SourceToken, Separated (DataCtor a))
bd)
  DeclType a
_ (DataHead SourceToken
_ Name (ProperName 'TypeName)
a [TypeVarBinding a]
vars) SourceToken
_ Type a
bd ->
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SourceAnn
-> ProperName 'TypeName
-> [(Text, Maybe SourceType)]
-> SourceType
-> Declaration
AST.TypeSynonymDeclaration SourceAnn
ann
      (forall a. Name a -> a
nameValue Name (ProperName 'TypeName)
a)
      (TypeVarBinding a -> (Text, Maybe SourceType)
goTypeVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding a]
vars)
      (forall a. String -> Type a -> SourceType
convertType String
fileName Type a
bd)
  DeclNewtype a
_ (DataHead SourceToken
_ Name (ProperName 'TypeName)
a [TypeVarBinding a]
vars) SourceToken
st Name (ProperName 'ConstructorName)
x Type a
ys -> do
    let ctrs :: [DataConstructorDeclaration]
ctrs = [SourceAnn
-> ProperName 'ConstructorName
-> [(Ident, SourceType)]
-> DataConstructorDeclaration
AST.DataConstructorDeclaration (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName SourceToken
st (forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Declaration a -> TokenRange
declRange Declaration a
decl)) (forall a. Name a -> a
nameValue Name (ProperName 'ConstructorName)
x) [(forall a. [a] -> a
head [Ident]
ctrFields, forall a. String -> Type a -> SourceType
convertType String
fileName Type a
ys)]]
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SourceAnn
-> DataDeclType
-> ProperName 'TypeName
-> [(Text, Maybe SourceType)]
-> [DataConstructorDeclaration]
-> Declaration
AST.DataDeclaration SourceAnn
ann DataDeclType
Env.Newtype (forall a. Name a -> a
nameValue Name (ProperName 'TypeName)
a) (TypeVarBinding a -> (Text, Maybe SourceType)
goTypeVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding a]
vars) [DataConstructorDeclaration]
ctrs
  DeclClass a
_ (ClassHead SourceToken
_ Maybe (OneOrDelimited (Constraint a), SourceToken)
sup Name (ProperName 'ClassName)
name [TypeVarBinding a]
vars Maybe (SourceToken, Separated ClassFundep)
fdeps) Maybe (SourceToken, NonEmpty (Labeled (Name Ident) (Type a)))
bd -> do
    let
      goTyVar :: TypeVarBinding a -> Ident
goTyVar (TypeVarKinded (Wrapped SourceToken
_ (Labeled Name Ident
a SourceToken
_ Type a
_) SourceToken
_)) = forall a. Name a -> a
nameValue Name Ident
a
      goTyVar (TypeVarName Name Ident
a) = forall a. Name a -> a
nameValue Name Ident
a
      vars' :: [(Ident, Int)]
vars' = forall a b. [a] -> [b] -> [(a, b)]
zip (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall {a}. TypeVarBinding a -> Ident
goTyVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding a]
vars) [Int
0..]
      goName :: Name Ident -> Int
goName = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Ident, Int)]
vars' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Name a -> a
nameValue
      goFundep :: ClassFundep -> FunctionalDependency
goFundep (FundepDetermined SourceToken
_ NonEmpty (Name Ident)
bs) = [Int] -> [Int] -> FunctionalDependency
Env.FunctionalDependency [] (Name Ident -> Int
goName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Name Ident)
bs)
      goFundep (FundepDetermines NonEmpty (Name Ident)
as SourceToken
_ NonEmpty (Name Ident)
bs) = [Int] -> [Int] -> FunctionalDependency
Env.FunctionalDependency (Name Ident -> Int
goName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Name Ident)
as) (Name Ident -> Int
goName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Name Ident)
bs)
      goSig :: Labeled (Name Ident) (Type a) -> Declaration
goSig (Labeled Name Ident
n SourceToken
_ Type a
ty) = do
        let
          ty' :: SourceType
ty' = forall a. String -> Type a -> SourceType
convertType String
fileName Type a
ty
          ann' :: SourceAnn
ann' = TokenAnn -> SourceAnn -> SourceAnn
widenLeft (SourceToken -> TokenAnn
tokAnn forall a b. (a -> b) -> a -> b
$ forall a. Name a -> SourceToken
nameTok Name Ident
n) forall a b. (a -> b) -> a -> b
$ forall a. Type a -> a
T.getAnnForType SourceType
ty'
        TypeDeclarationData -> Declaration
AST.TypeDeclaration forall a b. (a -> b) -> a -> b
$ SourceAnn -> Ident -> SourceType -> TypeDeclarationData
AST.TypeDeclarationData SourceAnn
ann' (Ident -> Ident
ident forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
n) SourceType
ty'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SourceAnn
-> ProperName 'ClassName
-> [(Text, Maybe SourceType)]
-> [SourceConstraint]
-> [FunctionalDependency]
-> [Declaration]
-> Declaration
AST.TypeClassDeclaration SourceAnn
ann
      (forall a. Name a -> a
nameValue Name (ProperName 'ClassName)
name)
      (TypeVarBinding a -> (Text, Maybe SourceType)
goTypeVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeVarBinding a]
vars)
      (forall a. String -> Constraint a -> SourceConstraint
convertConstraint String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Maybe (OneOrDelimited (Constraint a), SourceToken)
sup)
      (ClassFundep -> FunctionalDependency
goFundep forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Maybe (SourceToken, Separated ClassFundep)
fdeps)
      (Labeled (Name Ident) (Type a) -> Declaration
goSig forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. NonEmpty a -> [a]
NE.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Maybe (SourceToken, NonEmpty (Labeled (Name Ident) (Type a)))
bd)
  DeclInstanceChain a
_ Separated (Instance a)
insts -> do
    let
      chainId :: ChainId
chainId = String -> SourcePos -> ChainId
mkChainId String
fileName forall a b. (a -> b) -> a -> b
$ SourceToken -> SourcePos
startSourcePos forall a b. (a -> b) -> a -> b
$ forall a. InstanceHead a -> SourceToken
instKeyword forall a b. (a -> b) -> a -> b
$ forall a. Instance a -> InstanceHead a
instHead forall a b. (a -> b) -> a -> b
$ forall a. Separated a -> a
sepHead Separated (Instance a)
insts
      goInst :: Integer -> Instance a -> Declaration
goInst Integer
ix inst :: Instance a
inst@(Instance (InstanceHead SourceToken
_ Maybe (Name Ident, SourceToken)
nameSep Maybe (OneOrDelimited (Constraint a), SourceToken)
ctrs QualifiedName (ProperName 'ClassName)
cls [Type a]
args) Maybe (SourceToken, NonEmpty (InstanceBinding a))
bd) = do
        let ann' :: SourceAnn
ann' = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Instance a -> TokenRange
instanceRange Instance a
inst
            clsAnn :: SourceAnn
clsAnn = QualifiedName (ProperName 'ClassName) -> [Type a] -> SourceAnn
findInstanceAnn QualifiedName (ProperName 'ClassName)
cls [Type a]
args
        SourceAnn
-> SourceAnn
-> ChainId
-> Integer
-> Either Text Ident
-> [SourceConstraint]
-> Qualified (ProperName 'ClassName)
-> [SourceType]
-> TypeInstanceBody
-> Declaration
AST.TypeInstanceDeclaration SourceAnn
ann' SourceAnn
clsAnn ChainId
chainId Integer
ix
          (forall a.
Maybe (Name Ident, SourceToken)
-> QualifiedName (ProperName 'ClassName)
-> [Type a]
-> Either Text Ident
mkPartialInstanceName Maybe (Name Ident, SourceToken)
nameSep QualifiedName (ProperName 'ClassName)
cls [Type a]
args)
          (forall a. String -> Constraint a -> SourceConstraint
convertConstraint String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Maybe (OneOrDelimited (Constraint a), SourceToken)
ctrs)
          (forall a. QualifiedName a -> Qualified a
qualified QualifiedName (ProperName 'ClassName)
cls)
          (forall a. String -> Type a -> SourceType
convertType String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type a]
args)
          ([Declaration] -> TypeInstanceBody
AST.ExplicitInstance forall a b. (a -> b) -> a -> b
$ InstanceBinding a -> Declaration
goInstanceBinding forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a. NonEmpty a -> [a]
NE.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) Maybe (SourceToken, NonEmpty (InstanceBinding a))
bd)
    forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Instance a -> Declaration
goInst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Separated (Instance a)
insts)
  DeclDerive a
_ SourceToken
_ Maybe SourceToken
new (InstanceHead SourceToken
kw Maybe (Name Ident, SourceToken)
nameSep Maybe (OneOrDelimited (Constraint a), SourceToken)
ctrs QualifiedName (ProperName 'ClassName)
cls [Type a]
args) -> do
    let
      chainId :: ChainId
chainId = String -> SourcePos -> ChainId
mkChainId String
fileName forall a b. (a -> b) -> a -> b
$ SourceToken -> SourcePos
startSourcePos SourceToken
kw
      name' :: Either Text Ident
name' = forall a.
Maybe (Name Ident, SourceToken)
-> QualifiedName (ProperName 'ClassName)
-> [Type a]
-> Either Text Ident
mkPartialInstanceName Maybe (Name Ident, SourceToken)
nameSep QualifiedName (ProperName 'ClassName)
cls [Type a]
args
      instTy :: TypeInstanceBody
instTy
        | forall a. Maybe a -> Bool
isJust Maybe SourceToken
new = TypeInstanceBody
AST.NewtypeInstance
        | Bool
otherwise = TypeInstanceBody
AST.DerivedInstance
      clsAnn :: SourceAnn
clsAnn = QualifiedName (ProperName 'ClassName) -> [Type a] -> SourceAnn
findInstanceAnn QualifiedName (ProperName 'ClassName)
cls [Type a]
args
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SourceAnn
-> SourceAnn
-> ChainId
-> Integer
-> Either Text Ident
-> [SourceConstraint]
-> Qualified (ProperName 'ClassName)
-> [SourceType]
-> TypeInstanceBody
-> Declaration
AST.TypeInstanceDeclaration SourceAnn
ann SourceAnn
clsAnn ChainId
chainId Integer
0 Either Text Ident
name'
      (forall a. String -> Constraint a -> SourceConstraint
convertConstraint String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Maybe (OneOrDelimited (Constraint a), SourceToken)
ctrs)
      (forall a. QualifiedName a -> Qualified a
qualified QualifiedName (ProperName 'ClassName)
cls)
      (forall a. String -> Type a -> SourceType
convertType String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type a]
args)
      TypeInstanceBody
instTy
  DeclKindSignature a
_ SourceToken
kw (Labeled Name (ProperName 'TypeName)
name SourceToken
_ Type a
ty) -> do
    let
      kindFor :: KindSignatureFor
kindFor = case SourceToken -> Token
tokValue SourceToken
kw of
        TokLowerName [] Text
"data" -> KindSignatureFor
AST.DataSig
        TokLowerName [] Text
"newtype" -> KindSignatureFor
AST.NewtypeSig
        TokLowerName [] Text
"type" -> KindSignatureFor
AST.TypeSynonymSig
        TokLowerName [] Text
"class" -> KindSignatureFor
AST.ClassSig
        Token
tok -> forall a. HasCallStack => String -> a
internalError forall a b. (a -> b) -> a -> b
$ String
"Invalid kind signature keyword " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack (Token -> Text
printToken Token
tok)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceAnn
-> KindSignatureFor
-> ProperName 'TypeName
-> SourceType
-> Declaration
AST.KindDeclaration SourceAnn
ann KindSignatureFor
kindFor (forall a. Name a -> a
nameValue Name (ProperName 'TypeName)
name) forall a b. (a -> b) -> a -> b
$ forall a. String -> Type a -> SourceType
convertType String
fileName Type a
ty
  DeclSignature a
_ Labeled (Name Ident) (Type a)
lbl ->
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. String -> Labeled (Name Ident) (Type a) -> Declaration
convertSignature String
fileName Labeled (Name Ident) (Type a)
lbl
  DeclValue a
_ ValueBindingFields a
fields ->
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
String -> SourceAnn -> ValueBindingFields a -> Declaration
convertValueBindingFields String
fileName SourceAnn
ann ValueBindingFields a
fields
  DeclFixity a
_ (FixityFields (SourceToken
_, Fixity
kw) (SourceToken
_, Integer
prec) FixityOp
fxop) -> do
    let
      assoc :: Associativity
assoc =  case Fixity
kw of
        Fixity
Infix  -> Associativity
AST.Infix
        Fixity
Infixr -> Associativity
AST.Infixr
        Fixity
Infixl -> Associativity
AST.Infixl
      fixity :: Fixity
fixity = Associativity -> Integer -> Fixity
AST.Fixity Associativity
assoc Integer
prec
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ SourceAnn -> Either ValueFixity TypeFixity -> Declaration
AST.FixityDeclaration SourceAnn
ann forall a b. (a -> b) -> a -> b
$ case FixityOp
fxop of
      FixityValue QualifiedName (Either Ident (ProperName 'ConstructorName))
name SourceToken
_ Name (OpName 'ValueOpName)
op -> do
        forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Fixity
-> Qualified (Either Ident (ProperName 'ConstructorName))
-> OpName 'ValueOpName
-> ValueFixity
AST.ValueFixity Fixity
fixity (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Ident -> Ident
ident forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. QualifiedName a -> Qualified a
qualified QualifiedName (Either Ident (ProperName 'ConstructorName))
name) (forall a. Name a -> a
nameValue Name (OpName 'ValueOpName)
op)
      FixityType SourceToken
_ QualifiedName (ProperName 'TypeName)
name SourceToken
_ Name (OpName 'TypeOpName)
op ->
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Fixity
-> Qualified (ProperName 'TypeName)
-> OpName 'TypeOpName
-> TypeFixity
AST.TypeFixity Fixity
fixity (forall a. QualifiedName a -> Qualified a
qualified QualifiedName (ProperName 'TypeName)
name) (forall a. Name a -> a
nameValue Name (OpName 'TypeOpName)
op)
  DeclForeign a
_ SourceToken
_ SourceToken
_ Foreign a
frn ->
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Foreign a
frn of
      ForeignValue (Labeled Name Ident
a SourceToken
_ Type a
b) ->
        SourceAnn -> Ident -> SourceType -> Declaration
AST.ExternDeclaration SourceAnn
ann (Ident -> Ident
ident forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
a) forall a b. (a -> b) -> a -> b
$ forall a. String -> Type a -> SourceType
convertType String
fileName Type a
b
      ForeignData SourceToken
_ (Labeled Name (ProperName 'TypeName)
a SourceToken
_ Type a
b) ->
        SourceAnn -> ProperName 'TypeName -> SourceType -> Declaration
AST.ExternDataDeclaration SourceAnn
ann (forall a. Name a -> a
nameValue Name (ProperName 'TypeName)
a) forall a b. (a -> b) -> a -> b
$ forall a. String -> Type a -> SourceType
convertType String
fileName Type a
b
      ForeignKind SourceToken
_ Name (ProperName 'TypeName)
a ->
        SourceAnn
-> DataDeclType
-> ProperName 'TypeName
-> [(Text, Maybe SourceType)]
-> [DataConstructorDeclaration]
-> Declaration
AST.DataDeclaration SourceAnn
ann DataDeclType
Env.Data (forall a. Name a -> a
nameValue Name (ProperName 'TypeName)
a) [] []
  DeclRole a
_ SourceToken
_ SourceToken
_ Name (ProperName 'TypeName)
name NonEmpty Role
roles ->
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ RoleDeclarationData -> Declaration
AST.RoleDeclaration forall a b. (a -> b) -> a -> b
$
      SourceAnn -> ProperName 'TypeName -> [Role] -> RoleDeclarationData
AST.RoleDeclarationData SourceAnn
ann (forall a. Name a -> a
nameValue Name (ProperName 'TypeName)
name) (Role -> Role
roleValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NE.toList NonEmpty Role
roles)
  where
  ann :: SourceAnn
ann =
    forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Declaration a -> TokenRange
declRange Declaration a
decl

  startSourcePos :: SourceToken -> Pos.SourcePos
  startSourcePos :: SourceToken -> SourcePos
startSourcePos = SourcePos -> SourcePos
sourcePos forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceRange -> SourcePos
srcStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenAnn -> SourceRange
tokRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. SourceToken -> TokenAnn
tokAnn

  mkPartialInstanceName :: Maybe (Name Ident, SourceToken) -> QualifiedName (N.ProperName 'N.ClassName) -> [Type a] -> Either Text.Text N.Ident
  mkPartialInstanceName :: forall a.
Maybe (Name Ident, SourceToken)
-> QualifiedName (ProperName 'ClassName)
-> [Type a]
-> Either Text Ident
mkPartialInstanceName Maybe (Name Ident, SourceToken)
nameSep QualifiedName (ProperName 'ClassName)
cls [Type a]
args =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Text
genName) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Ident
ident forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Name a -> a
nameValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Maybe (Name Ident, SourceToken)
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
genName = Int -> Text -> Text
Text.take Int
25 (Text
className forall a. Semigroup a => a -> a -> a
<> Text
typeArgs)

      className :: Text.Text
      className :: Text
className
        = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Char -> Text -> Text
Text.cons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Char -> Char
toLower)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
Text.uncons
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: ProperNameType). ProperName a -> Text
N.runProperName
        forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> a
qualName QualifiedName (ProperName 'ClassName)
cls

      typeArgs :: Text.Text
      typeArgs :: Text
typeArgs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. Type a -> Text
argName [Type a]
args

      argName :: Type a -> Text.Text
      argName :: forall a. Type a -> 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{} -> Text
""
        TypeConstructor a
_ QualifiedName (ProperName 'TypeName)
qn -> forall (a :: ProperNameType). ProperName a -> Text
N.runProperName forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> a
qualName QualifiedName (ProperName 'TypeName)
qn
        TypeOpName a
_ QualifiedName (OpName 'TypeOpName)
qn -> forall (a :: OpNameType). OpName a -> Text
N.runOpName forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> a
qualName QualifiedName (OpName 'TypeOpName)
qn
        TypeString a
_ SourceToken
_ PSString
ps -> PSString -> Text
prettyPrintStringJS PSString
ps
        TypeInt a
_ Maybe SourceToken
_ SourceToken
_ Integer
nt -> String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Integer
nt

        -- Typed holes are disallowed in instance heads
        TypeHole{} -> Text
""
        TypeParens a
_ Wrapped (Type a)
t -> forall a. Type a -> Text
argName forall a b. (a -> b) -> a -> b
$ forall a. Wrapped a -> a
wrpValue Wrapped (Type a)
t
        TypeKinded a
_ Type a
t1 SourceToken
_ Type a
t2 -> forall a. Type a -> Text
argName Type a
t1 forall a. Semigroup a => a -> a -> a
<> forall a. Type a -> Text
argName Type a
t2
        TypeRecord a
_ Wrapped (Row a)
_ -> Text
"Record"
        TypeRow a
_ Wrapped (Row a)
_ -> Text
"Row"
        TypeArrName a
_ SourceToken
_ -> Text
"Function"
        TypeWildcard{} -> Text
"_"

        -- Polytypes are disallowed in instance heads
        TypeForall{} -> Text
""
        TypeApp a
_ Type a
t1 Type a
t2 -> forall a. Type a -> Text
argName Type a
t1 forall a. Semigroup a => a -> a -> a
<> forall a. Type a -> Text
argName Type a
t2
        TypeOp a
_ Type a
t1 QualifiedName (OpName 'TypeOpName)
op Type a
t2 ->
          forall a. Type a -> Text
argName Type a
t1 forall a. Semigroup a => a -> a -> a
<> forall (a :: OpNameType). OpName a -> Text
N.runOpName (forall a. QualifiedName a -> a
qualName QualifiedName (OpName 'TypeOpName)
op) forall a. Semigroup a => a -> a -> a
<> forall a. Type a -> Text
argName Type a
t2
        TypeArr a
_ Type a
t1 SourceToken
_ Type a
t2 -> forall a. Type a -> Text
argName Type a
t1 forall a. Semigroup a => a -> a -> a
<> Text
"Function" forall a. Semigroup a => a -> a -> a
<> forall a. Type a -> Text
argName Type a
t2
        TypeConstrained{} -> Text
""
        TypeUnaryRow{} -> Text
"Row"

  goTypeVar :: TypeVarBinding a -> (Text, Maybe SourceType)
goTypeVar = \case
    TypeVarKinded (Wrapped SourceToken
_ (Labeled Name Ident
x SourceToken
_ Type a
y) SourceToken
_) -> (Ident -> Text
getIdent forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
x, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. String -> Type a -> SourceType
convertType String
fileName Type a
y)
    TypeVarName Name Ident
x -> (Ident -> Text
getIdent forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
x, forall a. Maybe a
Nothing)

  goInstanceBinding :: InstanceBinding a -> Declaration
goInstanceBinding = \case
    InstanceBindingSignature a
_ Labeled (Name Ident) (Type a)
lbl ->
      forall a. String -> Labeled (Name Ident) (Type a) -> Declaration
convertSignature String
fileName Labeled (Name Ident) (Type a)
lbl
    binding :: InstanceBinding a
binding@(InstanceBindingName a
_ ValueBindingFields a
fields) -> do
      let ann' :: SourceAnn
ann' = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. InstanceBinding a -> TokenRange
instanceBindingRange InstanceBinding a
binding
      forall a.
String -> SourceAnn -> ValueBindingFields a -> Declaration
convertValueBindingFields String
fileName SourceAnn
ann' ValueBindingFields a
fields

  findInstanceAnn :: QualifiedName (ProperName 'ClassName) -> [Type a] -> SourceAnn
findInstanceAnn QualifiedName (ProperName 'ClassName)
cls [Type a]
args = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type a]
args then
      forall a. QualifiedName a -> TokenRange
qualRange QualifiedName (ProperName 'ClassName)
cls
    else
      (forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. QualifiedName a -> TokenRange
qualRange QualifiedName (ProperName 'ClassName)
cls, forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. Type a -> TokenRange
typeRange forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [Type a]
args)

convertSignature :: String -> Labeled (Name Ident) (Type a) -> AST.Declaration
convertSignature :: forall a. String -> Labeled (Name Ident) (Type a) -> Declaration
convertSignature String
fileName (Labeled Name Ident
a SourceToken
_ Type a
b) = do
  let
    b' :: SourceType
b' = forall a. String -> Type a -> SourceType
convertType String
fileName Type a
b
    ann :: SourceAnn
ann = TokenAnn -> SourceAnn -> SourceAnn
widenLeft (SourceToken -> TokenAnn
tokAnn forall a b. (a -> b) -> a -> b
$ forall a. Name a -> SourceToken
nameTok Name Ident
a) forall a b. (a -> b) -> a -> b
$ forall a. Type a -> a
T.getAnnForType SourceType
b'
  TypeDeclarationData -> Declaration
AST.TypeDeclaration forall a b. (a -> b) -> a -> b
$ SourceAnn -> Ident -> SourceType -> TypeDeclarationData
AST.TypeDeclarationData SourceAnn
ann (Ident -> Ident
ident forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
a) SourceType
b'

convertValueBindingFields :: String -> Pos.SourceAnn -> ValueBindingFields a -> AST.Declaration
convertValueBindingFields :: forall a.
String -> SourceAnn -> ValueBindingFields a -> Declaration
convertValueBindingFields String
fileName SourceAnn
ann (ValueBindingFields Name Ident
a [Binder a]
bs Guarded a
c) = do
  let
    bs' :: [Binder]
bs' = forall a. String -> Binder a -> Binder
convertBinder String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Binder a]
bs
    cs' :: [GuardedExpr]
cs' = forall a. String -> Guarded a -> [GuardedExpr]
convertGuarded String
fileName Guarded a
c
  ValueDeclarationData [GuardedExpr] -> Declaration
AST.ValueDeclaration forall a b. (a -> b) -> a -> b
$ forall a.
SourceAnn
-> Ident -> NameKind -> [Binder] -> a -> ValueDeclarationData a
AST.ValueDeclarationData SourceAnn
ann (Ident -> Ident
ident forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
a) NameKind
Env.Public [Binder]
bs' [GuardedExpr]
cs'

convertImportDecl
  :: String
  -> ImportDecl a
  -> (Pos.SourceAnn, N.ModuleName, AST.ImportDeclarationType, Maybe N.ModuleName)
convertImportDecl :: forall a.
String
-> ImportDecl a
-> (SourceAnn, ModuleName, ImportDeclarationType, Maybe ModuleName)
convertImportDecl String
fileName decl :: ImportDecl a
decl@(ImportDecl a
_ SourceToken
_ Name ModuleName
modName Maybe (Maybe SourceToken, DelimitedNonEmpty (Import a))
mbNames Maybe (SourceToken, Name ModuleName)
mbQual) = do
  let
    ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. ImportDecl a -> TokenRange
importDeclRange ImportDecl a
decl
    importTy :: ImportDeclarationType
importTy = case Maybe (Maybe SourceToken, DelimitedNonEmpty (Import a))
mbNames of
      Maybe (Maybe SourceToken, DelimitedNonEmpty (Import a))
Nothing -> ImportDeclarationType
AST.Implicit
      Just (Maybe SourceToken
hiding, Wrapped SourceToken
_ Separated (Import a)
imps SourceToken
_) -> do
        let imps' :: [DeclarationRef]
imps' = forall a. String -> Import a -> DeclarationRef
convertImport String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Separated (Import a)
imps
        if forall a. Maybe a -> Bool
isJust Maybe SourceToken
hiding
          then [DeclarationRef] -> ImportDeclarationType
AST.Hiding [DeclarationRef]
imps'
          else [DeclarationRef] -> ImportDeclarationType
AST.Explicit [DeclarationRef]
imps'
  (SourceAnn
ann, forall a. Name a -> a
nameValue Name ModuleName
modName, ImportDeclarationType
importTy, forall a. Name a -> a
nameValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (SourceToken, Name ModuleName)
mbQual)

convertImport :: String -> Import a -> AST.DeclarationRef
convertImport :: forall a. String -> Import a -> DeclarationRef
convertImport String
fileName Import a
imp = case Import a
imp of
  ImportValue a
_ Name Ident
a ->
    SourceSpan -> Ident -> DeclarationRef
AST.ValueRef SourceSpan
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Ident
ident forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
a
  ImportOp a
_ Name (OpName 'ValueOpName)
a ->
    SourceSpan -> OpName 'ValueOpName -> DeclarationRef
AST.ValueOpRef SourceSpan
ann forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name (OpName 'ValueOpName)
a
  ImportType a
_ Name (ProperName 'TypeName)
a Maybe (DataMembers a)
mb -> do
    let
      ctrs :: Maybe [ProperName 'ConstructorName]
ctrs = case Maybe (DataMembers a)
mb of
        Maybe (DataMembers a)
Nothing -> forall a. a -> Maybe a
Just []
        Just (DataAll a
_ SourceToken
_) -> forall a. Maybe a
Nothing
        Just (DataEnumerated a
_ (Wrapped SourceToken
_ Maybe (Separated (Name (ProperName 'ConstructorName)))
Nothing SourceToken
_)) -> forall a. a -> Maybe a
Just []
        Just (DataEnumerated a
_ (Wrapped SourceToken
_ (Just Separated (Name (ProperName 'ConstructorName))
idents) SourceToken
_)) ->
          forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Name a -> a
nameValue forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Separated (Name (ProperName 'ConstructorName))
idents
    SourceSpan
-> ProperName 'TypeName
-> Maybe [ProperName 'ConstructorName]
-> DeclarationRef
AST.TypeRef SourceSpan
ann (forall a. Name a -> a
nameValue Name (ProperName 'TypeName)
a) Maybe [ProperName 'ConstructorName]
ctrs
  ImportTypeOp a
_ SourceToken
_ Name (OpName 'TypeOpName)
a ->
    SourceSpan -> OpName 'TypeOpName -> DeclarationRef
AST.TypeOpRef SourceSpan
ann forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name (OpName 'TypeOpName)
a
  ImportClass a
_ SourceToken
_ Name (ProperName 'ClassName)
a ->
    SourceSpan -> ProperName 'ClassName -> DeclarationRef
AST.TypeClassRef SourceSpan
ann forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name (ProperName 'ClassName)
a
  where
  ann :: SourceSpan
ann = String -> SourceRange -> SourceSpan
sourceSpan String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenRange -> SourceRange
toSourceRange forall a b. (a -> b) -> a -> b
$ forall a. Import a -> TokenRange
importRange Import a
imp

convertExport :: String -> Export a -> AST.DeclarationRef
convertExport :: forall a. String -> Export a -> DeclarationRef
convertExport String
fileName Export a
export = case Export a
export of
  ExportValue a
_ Name Ident
a ->
    SourceSpan -> Ident -> DeclarationRef
AST.ValueRef SourceSpan
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Ident
ident forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name Ident
a
  ExportOp a
_ Name (OpName 'ValueOpName)
a ->
    SourceSpan -> OpName 'ValueOpName -> DeclarationRef
AST.ValueOpRef SourceSpan
ann forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name (OpName 'ValueOpName)
a
  ExportType a
_ Name (ProperName 'TypeName)
a Maybe (DataMembers a)
mb -> do
    let
      ctrs :: Maybe [ProperName 'ConstructorName]
ctrs = case Maybe (DataMembers a)
mb of
        Maybe (DataMembers a)
Nothing -> forall a. a -> Maybe a
Just []
        Just (DataAll a
_ SourceToken
_) -> forall a. Maybe a
Nothing
        Just (DataEnumerated a
_ (Wrapped SourceToken
_ Maybe (Separated (Name (ProperName 'ConstructorName)))
Nothing SourceToken
_)) -> forall a. a -> Maybe a
Just []
        Just (DataEnumerated a
_ (Wrapped SourceToken
_ (Just Separated (Name (ProperName 'ConstructorName))
idents) SourceToken
_)) ->
          forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Name a -> a
nameValue forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Separated (Name (ProperName 'ConstructorName))
idents
    SourceSpan
-> ProperName 'TypeName
-> Maybe [ProperName 'ConstructorName]
-> DeclarationRef
AST.TypeRef SourceSpan
ann (forall a. Name a -> a
nameValue Name (ProperName 'TypeName)
a) Maybe [ProperName 'ConstructorName]
ctrs
  ExportTypeOp a
_ SourceToken
_ Name (OpName 'TypeOpName)
a ->
    SourceSpan -> OpName 'TypeOpName -> DeclarationRef
AST.TypeOpRef SourceSpan
ann forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name (OpName 'TypeOpName)
a
  ExportClass a
_ SourceToken
_ Name (ProperName 'ClassName)
a ->
    SourceSpan -> ProperName 'ClassName -> DeclarationRef
AST.TypeClassRef SourceSpan
ann forall a b. (a -> b) -> a -> b
$ forall a. Name a -> a
nameValue Name (ProperName 'ClassName)
a
  ExportModule a
_ SourceToken
_ Name ModuleName
a ->
    SourceSpan -> ModuleName -> DeclarationRef
AST.ModuleRef SourceSpan
ann (forall a. Name a -> a
nameValue Name ModuleName
a)
  where
  ann :: SourceSpan
ann = String -> SourceRange -> SourceSpan
sourceSpan String
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. TokenRange -> SourceRange
toSourceRange forall a b. (a -> b) -> a -> b
$ forall a. Export a -> TokenRange
exportRange Export a
export

convertModule :: String -> Module a -> AST.Module
convertModule :: forall a. String -> Module a -> Module
convertModule String
fileName module' :: Module a
module'@(Module a
_ SourceToken
_ Name ModuleName
modName Maybe (DelimitedNonEmpty (Export a))
exps SourceToken
_ [ImportDecl a]
imps [Declaration a]
decls [Comment LineFeed]
_) = do
  let
    ann :: SourceAnn
ann = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> SourceToken -> SourceToken -> SourceAnn
sourceAnnCommented String
fileName) forall a b. (a -> b) -> a -> b
$ forall a. Module a -> TokenRange
moduleRange Module a
module'
    imps' :: [Declaration]
imps' = (SourceAnn, ModuleName, ImportDeclarationType, Maybe ModuleName)
-> Declaration
importCtrforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
String
-> ImportDecl a
-> (SourceAnn, ModuleName, ImportDeclarationType, Maybe ModuleName)
convertImportDecl String
fileName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ImportDecl a]
imps
    decls' :: [Declaration]
decls' = forall a. String -> Declaration a -> [Declaration]
convertDeclaration String
fileName forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Declaration a]
decls
    exps' :: Maybe [DeclarationRef]
exps' = forall a b. (a -> b) -> [a] -> [b]
map (forall a. String -> Export a -> DeclarationRef
convertExport String
fileName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Wrapped a -> a
wrpValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (DelimitedNonEmpty (Export a))
exps
  forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry SourceSpan
-> [Comment]
-> ModuleName
-> [Declaration]
-> Maybe [DeclarationRef]
-> Module
AST.Module SourceAnn
ann (forall a. Name a -> a
nameValue Name ModuleName
modName) ([Declaration]
imps' forall a. Semigroup a => a -> a -> a
<> [Declaration]
decls') Maybe [DeclarationRef]
exps'
  where
  importCtr :: (SourceAnn, ModuleName, ImportDeclarationType, Maybe ModuleName)
-> Declaration
importCtr (SourceAnn
a, ModuleName
b, ImportDeclarationType
c, Maybe ModuleName
d) = SourceAnn
-> ModuleName
-> ImportDeclarationType
-> Maybe ModuleName
-> Declaration
AST.ImportDeclaration SourceAnn
a ModuleName
b ImportDeclarationType
c Maybe ModuleName
d

ctrFields :: [N.Ident]
ctrFields :: [Ident]
ctrFields = [Text -> Ident
N.Ident (Text
"value" forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show (Integer
n :: Integer))) | Integer
n <- [Integer
0..]]