module Language.PureScript.AST.Utils where

import Protolude

import Language.PureScript.AST (Binder(..), CaseAlternative, Expr(..), GuardedExpr, Literal, pattern MkUnguarded, nullSourceSpan)
import Language.PureScript.Names (Ident, ModuleName, ProperName, ProperNameType(..), Qualified(..), QualifiedBy(..), byMaybeModuleName)
import Language.PureScript.Types (SourceType, Type(..))

lam :: Ident -> Expr -> Expr
lam :: Ident -> Expr -> Expr
lam = Binder -> Expr -> Expr
Abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Binder
mkBinder

lamCase :: Ident -> [CaseAlternative] -> Expr
lamCase :: Ident -> [CaseAlternative] -> Expr
lamCase Ident
s = Ident -> Expr -> Expr
lam Ident
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> [CaseAlternative] -> Expr
Case [Ident -> Expr
mkVar Ident
s]

lamCase2 :: Ident -> Ident -> [CaseAlternative] -> Expr
lamCase2 :: Ident -> Ident -> [CaseAlternative] -> Expr
lamCase2 Ident
s Ident
t = Ident -> Expr -> Expr
lam Ident
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Expr -> Expr
lam Ident
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expr] -> [CaseAlternative] -> Expr
Case [Ident -> Expr
mkVar Ident
s, Ident -> Expr
mkVar Ident
t]

mkRef :: Qualified Ident -> Expr
mkRef :: Qualified Ident -> Expr
mkRef = SourceSpan -> Qualified Ident -> Expr
Var SourceSpan
nullSourceSpan

mkVarMn :: Maybe ModuleName -> Ident -> Expr
mkVarMn :: Maybe ModuleName -> Ident -> Expr
mkVarMn Maybe ModuleName
mn = Qualified Ident -> Expr
mkRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. QualifiedBy -> a -> Qualified a
Qualified (Maybe ModuleName -> QualifiedBy
byMaybeModuleName Maybe ModuleName
mn)

mkVar :: Ident -> Expr
mkVar :: Ident -> Expr
mkVar = Maybe ModuleName -> Ident -> Expr
mkVarMn forall a. Maybe a
Nothing

mkBinder :: Ident -> Binder
mkBinder :: Ident -> Binder
mkBinder = SourceSpan -> Ident -> Binder
VarBinder SourceSpan
nullSourceSpan

mkLit :: Literal Expr -> Expr
mkLit :: Literal Expr -> Expr
mkLit = SourceSpan -> Literal Expr -> Expr
Literal SourceSpan
nullSourceSpan

mkCtor :: ModuleName -> ProperName 'ConstructorName -> Expr
mkCtor :: ModuleName -> ProperName 'ConstructorName -> Expr
mkCtor ModuleName
mn ProperName 'ConstructorName
name = SourceSpan -> Qualified (ProperName 'ConstructorName) -> Expr
Constructor SourceSpan
nullSourceSpan (forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) ProperName 'ConstructorName
name)

mkCtorBinder :: ModuleName -> ProperName 'ConstructorName -> [Binder] -> Binder
mkCtorBinder :: ModuleName -> ProperName 'ConstructorName -> [Binder] -> Binder
mkCtorBinder ModuleName
mn ProperName 'ConstructorName
name = SourceSpan
-> Qualified (ProperName 'ConstructorName) -> [Binder] -> Binder
ConstructorBinder SourceSpan
nullSourceSpan (forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
mn) ProperName 'ConstructorName
name)

unguarded :: Expr -> [GuardedExpr]
unguarded :: Expr -> [GuardedExpr]
unguarded Expr
e = [Expr -> GuardedExpr
MkUnguarded Expr
e]

data UnwrappedTypeConstructor = UnwrappedTypeConstructor
  { UnwrappedTypeConstructor -> ModuleName
utcModuleName :: ModuleName
  , UnwrappedTypeConstructor -> ProperName 'TypeName
utcTyCon :: ProperName 'TypeName
  , UnwrappedTypeConstructor -> [SourceType]
utcKindArgs :: [SourceType]
  , UnwrappedTypeConstructor -> [SourceType]
utcArgs :: [SourceType]
  }

utcQTyCon :: UnwrappedTypeConstructor -> Qualified (ProperName 'TypeName)
utcQTyCon :: UnwrappedTypeConstructor -> Qualified (ProperName 'TypeName)
utcQTyCon UnwrappedTypeConstructor{[SourceType]
ModuleName
ProperName 'TypeName
utcArgs :: [SourceType]
utcKindArgs :: [SourceType]
utcTyCon :: ProperName 'TypeName
utcModuleName :: ModuleName
utcArgs :: UnwrappedTypeConstructor -> [SourceType]
utcKindArgs :: UnwrappedTypeConstructor -> [SourceType]
utcTyCon :: UnwrappedTypeConstructor -> ProperName 'TypeName
utcModuleName :: UnwrappedTypeConstructor -> ModuleName
..} = forall a. QualifiedBy -> a -> Qualified a
Qualified (ModuleName -> QualifiedBy
ByModuleName ModuleName
utcModuleName) ProperName 'TypeName
utcTyCon

unwrapTypeConstructor :: SourceType -> Maybe UnwrappedTypeConstructor
unwrapTypeConstructor :: SourceType -> Maybe UnwrappedTypeConstructor
unwrapTypeConstructor = [SourceType]
-> [SourceType] -> SourceType -> Maybe UnwrappedTypeConstructor
go [] []
  where
  go :: [SourceType]
-> [SourceType] -> SourceType -> Maybe UnwrappedTypeConstructor
go [SourceType]
kargs [SourceType]
args = \case
    TypeConstructor SourceAnn
_ (Qualified (ByModuleName ModuleName
mn) ProperName 'TypeName
tyCon) -> forall a. a -> Maybe a
Just (ModuleName
-> ProperName 'TypeName
-> [SourceType]
-> [SourceType]
-> UnwrappedTypeConstructor
UnwrappedTypeConstructor ModuleName
mn ProperName 'TypeName
tyCon [SourceType]
kargs [SourceType]
args)
    TypeApp SourceAnn
_ SourceType
ty SourceType
arg -> [SourceType]
-> [SourceType] -> SourceType -> Maybe UnwrappedTypeConstructor
go [SourceType]
kargs (SourceType
arg forall a. a -> [a] -> [a]
: [SourceType]
args) SourceType
ty
    KindApp SourceAnn
_ SourceType
ty SourceType
karg -> [SourceType]
-> [SourceType] -> SourceType -> Maybe UnwrappedTypeConstructor
go (SourceType
karg forall a. a -> [a] -> [a]
: [SourceType]
kargs) [SourceType]
args SourceType
ty
    SourceType
_ -> forall a. Maybe a
Nothing