module SyntaxTrees.Scala.Type where import Data.List (intercalate) import SyntaxTrees.Scala.Common (Modifier, Package, QTypeClass, Var, showQualified) import Utils.Foldable (wrapMaybe) import Utils.String (Wrapper (..), joinMaybe, joinWords, str, wrapParens, wrapParensCsv, wrapSpaces, wrapSquareCsv, (+++)) newtype TypeParam = TypeParam String newtype TypeVar = TypeVar String data TypeCtor = TypeCtor String | Arrow | TupleType data Type = CtorTypeApply QTypeCtor [Type] | ParamTypeApply TypeParam [Type] | NestedTypeApply Type [Type] | TypeVar' QTypeVar | TypeParam' TypeParam | ExistentialType | TypeScope [TypeParam] Type | ClassScope [ClassConstraint] Type data ClassConstraint = ClassConstraint QTypeClass [Type] newtype ArgList = ArgList [ArgField] newtype UsingArgList = UsingArgList [UsingArgField] data ArgField = ArgField { ArgField -> [Modifier] modifiers :: [Modifier] , ArgField -> Var name :: Var , ArgField -> Type type' :: Type } data UsingArgField = UsingArgField { UsingArgField -> [Modifier] modifiers :: [Modifier] , UsingArgField -> Maybe Var name :: Maybe Var , UsingArgField -> ClassConstraint type' :: ClassConstraint } data QTypeVar = QTypeVar (Maybe Package) TypeVar data QTypeCtor = QTypeCtor (Maybe Package) TypeCtor instance Show TypeParam where show :: TypeParam -> String show (TypeParam String x) = String x instance Show TypeVar where show :: TypeVar -> String show (TypeVar String x) = String x instance Show TypeCtor where show :: TypeCtor -> String show (TypeCtor String x) = String x show TypeCtor Arrow = String "->" show TypeCtor TupleType = String "()" instance Show Type where show :: Type -> String show (CtorTypeApply (QTypeCtor Maybe Package _ TypeCtor Arrow) [Type] x) = forall a. [a] -> [[a]] -> [a] intercalate (ShowS wrapSpaces String "=>") forall a b. (a -> b) -> a -> b $ Type -> String showTypeNested forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Type] x show (CtorTypeApply x :: QTypeCtor x@(QTypeCtor Maybe Package _ (TypeCtor String _)) [Type] z) = forall a. Show a => a -> String show QTypeCtor x forall a. [a] -> [a] -> [a] ++ forall a. Show a => [a] -> String wrapSquareCsv [Type] z show (CtorTypeApply (QTypeCtor Maybe Package _ TypeCtor TupleType) [Type] x) = forall a. Show a => [a] -> String wrapParensCsv [Type] x show (ParamTypeApply TypeParam x [Type] y) = forall a. Show a => a -> String show TypeParam x forall a. [a] -> [a] -> [a] ++ forall a. Show a => [a] -> String wrapSquareCsv [Type] y show (NestedTypeApply Type x [Type] y) = Type -> String showTypeNested Type x forall a. [a] -> [a] -> [a] ++ forall a. Show a => [a] -> String wrapSquareCsv [Type] y show (TypeVar' QTypeVar x) = forall a. Show a => a -> String show QTypeVar x show (TypeParam' TypeParam x) = forall a. Show a => a -> String show TypeParam x show Type ExistentialType = String "?" show (TypeScope [TypeParam] x Type y) = forall a. Show a => [a] -> String wrapSquareCsv [TypeParam] x String -> ShowS +++ String "=>" String -> ShowS +++ Type -> String showTypeScopeNested Type y show (ClassScope [ClassConstraint] x Type y) = forall a. Show a => [a] -> String wrapParensCsv [ClassConstraint] x String -> ShowS +++ String "?=>" String -> ShowS +++ Type -> String showClassScopeNested Type y instance Show ArgList where show :: ArgList -> String show (ArgList [ArgField] x) = forall a. Show a => [a] -> String wrapParensCsv [ArgField] x instance Show UsingArgList where show :: UsingArgList -> String show (UsingArgList [UsingArgField] x) = ShowS wrapParens forall a b. (a -> b) -> a -> b $ String "using" forall a. Show a => String -> Maybe a -> String `joinMaybe` (String -> Wrapper Wrapper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) a. Foldable t => t a -> Maybe (t a) wrapMaybe (forall a. Show a => String -> [a] -> String str String ", " [UsingArgField] x)) instance Show ArgField where show :: ArgField -> String show (ArgField [Modifier] x Var y Type z) = [String] -> String joinWords [forall a. Show a => String -> [a] -> String str String " " [Modifier] x, forall a. Show a => a -> String show Var y forall a. [a] -> [a] -> [a] ++ String ":", forall a. Show a => a -> String show Type z] instance Show UsingArgField where show :: UsingArgField -> String show (UsingArgField [Modifier] x Maybe Var y ClassConstraint z) = [String] -> String joinWords [forall a. Show a => String -> [a] -> String str String " " [Modifier] x, String ":" forall a. Show a => String -> Maybe a -> String `joinMaybe` Maybe Var y, forall a. Show a => a -> String show ClassConstraint z] instance Show ClassConstraint where show :: ClassConstraint -> String show (ClassConstraint QTypeClass x [Type] y) = forall a. Show a => a -> String show QTypeClass x forall a. [a] -> [a] -> [a] ++ forall a. Show a => [a] -> String wrapSquareCsv [Type] y instance Show QTypeVar where show :: QTypeVar -> String show (QTypeVar Maybe Package x TypeVar y) = forall a b. (Show a, Show b) => Maybe a -> b -> String showQualified Maybe Package x TypeVar y instance Show QTypeCtor where show :: QTypeCtor -> String show (QTypeCtor Maybe Package x TypeCtor y) = forall a b. (Show a, Show b) => Maybe a -> b -> String showQualified Maybe Package x TypeCtor y showTypeNested :: Type -> String showTypeNested :: Type -> String showTypeNested Type x = ShowS transformFn forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show Type x where transformFn :: ShowS transformFn = if Bool shouldWrap then ShowS wrapParens else forall a. a -> a id shouldWrap :: Bool shouldWrap = case Type x of (CtorTypeApply (QTypeCtor Maybe Package _ TypeCtor Arrow) [Type] _) -> Bool True (TypeScope [TypeParam] _ Type _) -> Bool True (ClassScope [ClassConstraint] _ Type _) -> Bool True Type _ -> Bool False showTypeScopeNested :: Type -> String showTypeScopeNested :: Type -> String showTypeScopeNested Type x = ShowS transformFn forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show Type x where transformFn :: ShowS transformFn = if Bool shouldWrap then ShowS wrapParens else forall a. a -> a id shouldWrap :: Bool shouldWrap = case Type x of (TypeScope [TypeParam] _ Type _) -> Bool True Type _ -> Bool False showClassScopeNested :: Type -> String showClassScopeNested :: Type -> String showClassScopeNested Type x = ShowS transformFn forall a b. (a -> b) -> a -> b $ forall a. Show a => a -> String show Type x where transformFn :: ShowS transformFn = if Bool shouldWrap then ShowS wrapParens else forall a. a -> a id shouldWrap :: Bool shouldWrap = case Type x of (TypeScope [TypeParam] _ Type _) -> Bool True (ClassScope [ClassConstraint] _ Type _) -> Bool True Type _ -> Bool False