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