module Conversions.ToScala.Type where

import qualified SyntaxTrees.Haskell.Type as H
import qualified SyntaxTrees.Scala.Common as S
import qualified SyntaxTrees.Scala.Type   as S

import Conversions.ToScala.Common (find, qClass, qualifier')

import Data.Char (toUpper)
import Data.Map  (Map)
import Data.Set  (Set)

import qualified Data.Map as Map
import qualified Data.Set as Set



typeParam :: H.TypeParam -> S.TypeParam
typeParam :: TypeParam -> TypeParam
typeParam (H.TypeParam String
x) = String -> TypeParam
S.TypeParam forall a b. (a -> b) -> a -> b
$ Char -> Char
toUpper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
x

typeVar :: H.TypeVar -> S.TypeVar
typeVar :: TypeVar -> TypeVar
typeVar (H.TypeVar String
x) = String -> TypeVar
S.TypeVar forall a b. (a -> b) -> a -> b
$ String -> String
convertTypeVar String
x
typeVar TypeVar
H.UnitType    = String -> TypeVar
S.TypeVar String
"Unit"

typeCtor :: H.TypeCtor -> S.TypeCtor
typeCtor :: TypeCtor -> TypeCtor
typeCtor TypeCtor
H.Arrow        = TypeCtor
S.Arrow
typeCtor TypeCtor
H.TupleType    = TypeCtor
S.TupleType
typeCtor (H.TypeCtor String
x) = String -> TypeCtor
S.TypeCtor forall a b. (a -> b) -> a -> b
$ String -> String
convertTypeCtor String
x
typeCtor TypeCtor
H.ListType     = String -> TypeCtor
S.TypeCtor String
"List"

anyKindedType :: H.AnyKindedType -> S.Type
anyKindedType :: AnyKindedType -> Type
anyKindedType (H.TypeValue Type
x) = Type -> Type
type' Type
x
anyKindedType (H.TypeFn (H.QTypeCtor Maybe Module
_ TypeCtor
H.ListType)) =
  QTypeCtor -> [Type] -> Type
S.CtorTypeApply (Maybe Package -> TypeCtor -> QTypeCtor
S.QTypeCtor forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> TypeCtor
S.TypeCtor String
"List") [Type
S.ExistentialType]
anyKindedType (H.TypeFn (H.QTypeCtor Maybe Module
_ TypeCtor
H.Arrow)) =
  QTypeCtor -> [Type] -> Type
S.CtorTypeApply (Maybe Package -> TypeCtor -> QTypeCtor
S.QTypeCtor forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> TypeCtor
S.TypeCtor String
"Function2")
                                             [Type
S.ExistentialType, Type
S.ExistentialType]
anyKindedType (H.TypeFn (H.QTypeCtor Maybe Module
_ TypeCtor
H.TupleType)) =
  QTypeCtor -> [Type] -> Type
S.CtorTypeApply (Maybe Package -> TypeCtor -> QTypeCtor
S.QTypeCtor forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ String -> TypeCtor
S.TypeCtor String
"Tuple2")
                                             [Type
S.ExistentialType, Type
S.ExistentialType]
anyKindedType (H.TypeFn x :: QTypeCtor
x@(H.QTypeCtor Maybe Module
_ TypeCtor
_)) = QTypeCtor -> [Type] -> Type
S.CtorTypeApply (QTypeCtor -> QTypeCtor
qTypeCtor QTypeCtor
x)
                                             [Type
S.ExistentialType]


classConstraint :: H.ClassConstraint -> S.ClassConstraint
classConstraint :: ClassConstraint -> ClassConstraint
classConstraint (H.ClassConstraint QClass
x [Type]
y) = QTypeClass -> [Type] -> ClassConstraint
S.ClassConstraint (QClass -> QTypeClass
qClass QClass
x) (Type -> Type
type' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
y)


type' :: H.Type -> S.Type
type' :: Type -> Type
type' (H.CtorTypeApply QTypeCtor
x [Type]
y)   = QTypeCtor -> [Type] -> Type
S.CtorTypeApply (QTypeCtor -> QTypeCtor
qTypeCtor QTypeCtor
x) (Type -> Type
type' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
y)
type' (H.ParamTypeApply TypeParam
x [Type]
y)  = TypeParam -> [Type] -> Type
S.ParamTypeApply (TypeParam -> TypeParam
typeParam TypeParam
x) (Type -> Type
type' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
y)
type' (H.NestedTypeApply Type
x [Type]
y) = Type -> [Type] -> Type
S.NestedTypeApply (Type -> Type
type' Type
x) (Type -> Type
type' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
y)
type' (H.TypeVar' QTypeVar
x)          = QTypeVar -> Type
S.TypeVar' forall a b. (a -> b) -> a -> b
$ QTypeVar -> QTypeVar
qTypeVar QTypeVar
x
type' (H.TypeParam' TypeParam
x)        = TypeParam -> Type
S.TypeParam' forall a b. (a -> b) -> a -> b
$ TypeParam -> TypeParam
typeParam TypeParam
x
type' (H.TypeScope [TypeParam]
x Type
y)       = [TypeParam] -> Type -> Type
S.TypeScope (TypeParam -> TypeParam
typeParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeParam]
x) (Type -> Type
type' Type
y)
type' (H.ClassScope [ClassConstraint]
x Type
y)      = [ClassConstraint] -> Type -> Type
S.ClassScope (ClassConstraint -> ClassConstraint
classConstraint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClassConstraint]
x) (Type -> Type
type' Type
y)


typeSplit :: Int -> H.Type -> ([S.Type], S.Type)
typeSplit :: Int -> Type -> ([Type], Type)
typeSplit Int
0 Type
tpe = ([], Type -> Type
type' Type
tpe)
typeSplit Int
n Type
tpe = ([Type]
args, QTypeCtor -> [Type] -> Type
S.CtorTypeApply (Maybe Package -> TypeCtor -> QTypeCtor
S.QTypeCtor forall a. Maybe a
Nothing TypeCtor
S.Arrow) [Type]
ret)
  where
    ([Type]
args, [Type]
ret) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall a. Ord a => a -> a -> a
min Int
n (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
types forall a. Num a => a -> a -> a
- Int
1)) (Type -> Type
type' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
types)
    types :: [Type]
types = Type -> [Type]
extractTypes Type
tpe


classScopeSplit :: H.Type -> ([S.ClassConstraint], H.Type)
classScopeSplit :: Type -> ([ClassConstraint], Type)
classScopeSplit (H.ClassScope [ClassConstraint]
x Type
y) = (ClassConstraint -> ClassConstraint
classConstraint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClassConstraint]
x, Type
y)
classScopeSplit Type
x                  = ([], Type
x)


findAnyKindedTypeParams :: H.AnyKindedType -> Set H.TypeParam
findAnyKindedTypeParams :: AnyKindedType -> Set TypeParam
findAnyKindedTypeParams (H.TypeValue Type
x) = Type -> Set TypeParam
findTypeParams Type
x
findAnyKindedTypeParams AnyKindedType
_               = forall a. Set a
Set.empty


findTypeParams :: H.Type -> Set H.TypeParam
findTypeParams :: Type -> Set TypeParam
findTypeParams (H.CtorTypeApply QTypeCtor
_ [Type]
y)   = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ Type -> Set TypeParam
findTypeParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
y
findTypeParams (H.ParamTypeApply TypeParam
x [Type]
y)  = (forall a. a -> Set a
Set.singleton TypeParam
x) forall a. Semigroup a => a -> a -> a
<>
                                         (forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ Type -> Set TypeParam
findTypeParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
y)
findTypeParams (H.NestedTypeApply Type
x [Type]
y) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ Type -> Set TypeParam
findTypeParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type
x forall a. a -> [a] -> [a]
: [Type]
y)
findTypeParams (H.TypeVar' QTypeVar
_)          = forall a. Set a
Set.empty
findTypeParams (H.TypeParam' TypeParam
x)        = forall a. a -> Set a
Set.singleton TypeParam
x
findTypeParams (H.TypeScope [TypeParam]
_ Type
_)       = forall a. Set a
Set.empty
findTypeParams (H.ClassScope [ClassConstraint]
_ Type
y)      = Type -> Set TypeParam
findTypeParams Type
y


extractTypes :: H.Type -> [H.Type]
extractTypes :: Type -> [Type]
extractTypes (H.CtorTypeApply (H.QTypeCtor Maybe Module
_ TypeCtor
H.Arrow) [Type]
y) = [Type]
y
extractTypes (H.TypeScope [TypeParam]
_ Type
y)                           = Type -> [Type]
extractTypes Type
y
extractTypes (H.ClassScope [ClassConstraint]
_ Type
y)                          = Type -> [Type]
extractTypes Type
y
extractTypes Type
_                                           = []


argLists :: [S.Var] -> [S.Type] -> [S.ArgList]
argLists :: [Var] -> [Type] -> [ArgList]
argLists [Var]
args [Type]
argTypes =
  [ArgField] -> ArgList
S.ArgList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ([Modifier] -> Var -> Type -> ArgField
S.ArgField []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
args [Type]
argTypes


usingArgList :: [S.ClassConstraint] -> S.UsingArgList
usingArgList :: [ClassConstraint] -> UsingArgList
usingArgList [ClassConstraint]
constraints =
  [UsingArgField] -> UsingArgList
S.UsingArgList forall a b. (a -> b) -> a -> b
$ ([Modifier] -> Maybe Var -> ClassConstraint -> UsingArgField
S.UsingArgField [] forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClassConstraint]
constraints


qTypeVar :: H.QTypeVar -> S.QTypeVar
qTypeVar :: QTypeVar -> QTypeVar
qTypeVar (H.QTypeVar Maybe Module
x TypeVar
y) = Maybe Package -> TypeVar -> QTypeVar
S.QTypeVar (Module -> Package
qualifier' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Module
x) (TypeVar -> TypeVar
typeVar TypeVar
y)

qTypeCtor :: H.QTypeCtor -> S.QTypeCtor
qTypeCtor :: QTypeCtor -> QTypeCtor
qTypeCtor (H.QTypeCtor Maybe Module
x TypeCtor
y) = Maybe Package -> TypeCtor -> QTypeCtor
S.QTypeCtor (Module -> Package
qualifier' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Module
x) (TypeCtor -> TypeCtor
typeCtor TypeCtor
y)




convertTypeCtor :: String -> String
convertTypeCtor :: String -> String
convertTypeCtor String
x =  forall k. Ord k => Map k k -> k -> k
find Map String String
typeCtorMap String
x

convertTypeVar :: String -> String
convertTypeVar :: String -> String
convertTypeVar String
x =  forall k. Ord k => Map k k -> k -> k
find Map String String
typeVarMap String
x

typeCtorMap :: Map String String
typeCtorMap :: Map String String
typeCtorMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
"Maybe", String
"Option")]

typeVarMap :: Map String String
typeVarMap :: Map String String
typeVarMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
"Type", String
"Typex")]