module Language.PureScript.CST.Traversals.Type where

import Prelude

import Language.PureScript.CST.Types (Constraint(..), Labeled(..), Row(..), Type(..), Wrapped(..))
import Language.PureScript.CST.Traversals (everythingOnSeparated)

everythingOnTypes :: (r -> r -> r) -> (Type a -> r) -> Type a -> r
everythingOnTypes :: forall r a. (r -> r -> r) -> (Type a -> r) -> Type a -> r
everythingOnTypes r -> r -> r
op Type a -> r
k = Type a -> r
goTy
  where
  goTy :: Type a -> r
goTy Type a
ty = case Type a
ty of
    TypeVar a
_ Name Ident
_ -> Type a -> r
k Type a
ty
    TypeConstructor a
_ QualifiedName (ProperName 'TypeName)
_ -> Type a -> r
k Type a
ty
    TypeWildcard a
_ SourceToken
_ -> Type a -> r
k Type a
ty
    TypeHole a
_ Name Ident
_ -> Type a -> r
k Type a
ty
    TypeString a
_ SourceToken
_ PSString
_ -> Type a -> r
k Type a
ty
    TypeInt a
_ Maybe SourceToken
_ SourceToken
_ Integer
_ -> Type a -> r
k Type a
ty
    TypeRow a
_ (Wrapped SourceToken
_ Row a
row SourceToken
_) -> Type a -> Row a -> r
goRow Type a
ty Row a
row
    TypeRecord a
_ (Wrapped SourceToken
_ Row a
row SourceToken
_) -> Type a -> Row a -> r
goRow Type a
ty Row a
row
    TypeForall a
_ SourceToken
_ NonEmpty (TypeVarBinding a)
_ SourceToken
_ Type a
ty2 -> Type a -> r
k Type a
ty r -> r -> r
`op` Type a -> r
goTy Type a
ty2
    TypeKinded a
_ Type a
ty2 SourceToken
_ Type a
ty3 -> Type a -> r
k Type a
ty r -> r -> r
`op` (Type a -> r
goTy Type a
ty2 r -> r -> r
`op` Type a -> r
goTy Type a
ty3)
    TypeApp a
_ Type a
ty2 Type a
ty3 -> Type a -> r
k Type a
ty r -> r -> r
`op` (Type a -> r
goTy Type a
ty2 r -> r -> r
`op` Type a -> r
goTy Type a
ty3)
    TypeOp a
_ Type a
ty2 QualifiedName (OpName 'TypeOpName)
_ Type a
ty3 -> Type a -> r
k Type a
ty r -> r -> r
`op` (Type a -> r
goTy Type a
ty2 r -> r -> r
`op` Type a -> r
goTy Type a
ty3)
    TypeOpName a
_ QualifiedName (OpName 'TypeOpName)
_ -> Type a -> r
k Type a
ty
    TypeArr a
_ Type a
ty2 SourceToken
_ Type a
ty3 -> Type a -> r
k Type a
ty r -> r -> r
`op` (Type a -> r
goTy Type a
ty2 r -> r -> r
`op` Type a -> r
goTy Type a
ty3)
    TypeArrName a
_ SourceToken
_ -> Type a -> r
k Type a
ty
    TypeConstrained a
_ (forall {a}. Constraint a -> [Type a]
constraintTys -> [Type a]
ty2) SourceToken
_ Type a
ty3
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type a]
ty2 -> Type a -> r
k Type a
ty r -> r -> r
`op` Type a -> r
goTy Type a
ty3
      | Bool
otherwise -> Type a -> r
k Type a
ty r -> r -> r
`op` (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 r -> r -> r
op (Type a -> r
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type a]
ty2) r -> r -> r
`op` Type a -> r
goTy Type a
ty3)
    TypeParens a
_ (Wrapped SourceToken
_ Type a
ty2 SourceToken
_) -> Type a -> r
k Type a
ty r -> r -> r
`op` Type a -> r
goTy Type a
ty2
    TypeUnaryRow a
_ SourceToken
_ Type a
ty2 -> Type a -> r
k Type a
ty r -> r -> r
`op` Type a -> r
goTy Type a
ty2

  goRow :: Type a -> Row a -> r
goRow Type a
ty = \case
    Row Maybe (Separated (Labeled Label (Type a)))
Nothing Maybe (SourceToken, Type a)
Nothing -> Type a -> r
k Type a
ty
    Row Maybe (Separated (Labeled Label (Type a)))
Nothing (Just (SourceToken
_, Type a
ty2)) -> Type a -> r
k Type a
ty r -> r -> r
`op` Type a -> r
goTy Type a
ty2
    Row (Just Separated (Labeled Label (Type a))
lbls) Maybe (SourceToken, Type a)
Nothing -> Type a -> r
k Type a
ty r -> r -> r
`op` forall r a. (r -> r -> r) -> (a -> r) -> Separated a -> r
everythingOnSeparated r -> r -> r
op (Type a -> r
goTy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Labeled a b -> b
lblValue) Separated (Labeled Label (Type a))
lbls
    Row (Just Separated (Labeled Label (Type a))
lbls) (Just (SourceToken
_, Type a
ty2)) -> Type a -> r
k Type a
ty r -> r -> r
`op` (forall r a. (r -> r -> r) -> (a -> r) -> Separated a -> r
everythingOnSeparated r -> r -> r
op (Type a -> r
goTy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Labeled a b -> b
lblValue) Separated (Labeled Label (Type a))
lbls r -> r -> r
`op` Type a -> r
goTy Type a
ty2)

  constraintTys :: Constraint a -> [Type a]
constraintTys = \case
    Constraint a
_ QualifiedName (ProperName 'ClassName)
_ [Type a]
tys -> [Type a]
tys
    ConstraintParens a
_ (Wrapped SourceToken
_ Constraint a
c SourceToken
_) -> Constraint a -> [Type a]
constraintTys Constraint a
c