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