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
= \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]
= 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
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 = forall a. Bool -> String -> Type a -> SourceType
convertType' Bool
False
convertVtaType :: String -> Type a -> T.SourceType
convertVtaType :: forall a. String -> Type a -> SourceType
convertVtaType = forall a. Bool -> String -> Type a -> SourceType
convertType' Bool
True
convertType' :: Bool -> String -> Type a -> T.SourceType
convertType' :: forall a. Bool -> String -> Type a -> SourceType
convertType' Bool
withinVta 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) forall a b. (a -> b) -> a -> b
$ if Bool
withinVta then WildcardData
T.IgnoredWildcard else 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 -> Maybe a -> SourceType -> SourceType
mkForAll Name Ident
a Maybe SourceType
b Maybe a
v 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
-> TypeVarVisibility
-> Text
-> Maybe (Type a)
-> Type a
-> Maybe SkolemScope
-> Type a
T.ForAll SourceAnn
ann' (forall b a. b -> (a -> b) -> Maybe a -> b
maybe TypeVarVisibility
T.TypeVarInvisible (forall a b. a -> b -> a
const TypeVarVisibility
T.TypeVarVisible) Maybe a
v) (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 (Maybe SourceToken
v, Name Ident
a) SourceToken
_ Type a
b) SourceToken
_)) = forall {a}.
Name Ident
-> Maybe SourceType -> Maybe a -> SourceType -> SourceType
mkForAll Name Ident
a (forall a. a -> Maybe a
Just (Type a -> SourceType
go Type a
b)) Maybe SourceToken
v
k (TypeVarName (Maybe SourceToken
v, Name Ident
a)) = forall {a}.
Name Ident
-> Maybe SourceType -> Maybe a -> SourceType -> SourceType
mkForAll Name Ident
a forall a. Maybe a
Nothing Maybe SourceToken
v
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. Bool -> String -> Constraint a -> SourceConstraint
convertConstraint Bool
withinVta 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 :: Bool -> String -> Constraint a -> T.SourceConstraint
convertConstraint :: forall a. Bool -> String -> Constraint a -> SourceConstraint
convertConstraint Bool
withinVta 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. Bool -> String -> Type a -> SourceType
convertType' Bool
withinVta 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@(ExprVisibleTypeApp a
_ Expr a
a SourceToken
_ Type 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 -> SourceType -> Expr
AST.VisibleTypeApp (Expr a -> Expr
go Expr a
a) (forall a. String -> Type a -> SourceType
convertVtaType String
fileName Type 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 :: 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 (Maybe SourceToken
_, Name Ident
a) SourceToken
_ Type a
_) SourceToken
_)) = forall a. Name a -> a
nameValue Name Ident
a
goTyVar (TypeVarName (Maybe SourceToken
_, 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. Bool -> String -> Constraint a -> SourceConstraint
convertConstraint Bool
False 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. Bool -> String -> Constraint a -> SourceConstraint
convertConstraint Bool
False 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. Bool -> String -> Constraint a -> SourceConstraint
convertConstraint Bool
False 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
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
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
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
"_"
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 (Maybe SourceToken
_, 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 (Maybe SourceToken
_, 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..]]