module Conversions.ToPurescript.Type where

import qualified SyntaxTrees.Haskell.Type    as H
import qualified SyntaxTrees.Purescript.Type as P

import Conversions.ToPurescript.Common (find, module', qClass)

import Data.Map (Map)
import Data.Set (Set)

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



typeParam :: H.TypeParam -> P.TypeParam
typeParam :: TypeParam -> TypeParam
typeParam (H.TypeParam String
x) = String -> TypeParam
P.TypeParam  String
x

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

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

anyKindedType :: H.AnyKindedType -> P.AnyKindedType
anyKindedType :: AnyKindedType -> AnyKindedType
anyKindedType (H.TypeValue Type
x) = Type -> AnyKindedType
P.TypeValue forall a b. (a -> b) -> a -> b
$ Type -> Type
type' Type
x
anyKindedType (H.TypeFn QTypeCtor
x)    = QTypeCtor -> AnyKindedType
P.TypeFn forall a b. (a -> b) -> a -> b
$ QTypeCtor -> QTypeCtor
qTypeCtor QTypeCtor
x


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


type' :: H.Type -> P.Type
type' :: Type -> Type
type' (H.CtorTypeApply QTypeCtor
x [Type]
y)   = QTypeCtor -> [Type] -> Type
P.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
P.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
P.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
P.TypeVar' forall a b. (a -> b) -> a -> b
$ QTypeVar -> QTypeVar
qTypeVar QTypeVar
x
type' (H.TypeParam' TypeParam
x)        = TypeParam -> Type
P.TypeParam' forall a b. (a -> b) -> a -> b
$ TypeParam -> TypeParam
typeParam TypeParam
x
type' (H.TypeScope [TypeParam]
x Type
y)       = [TypeParam] -> Type -> Type
P.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
P.ClassScope (ClassConstraint -> ClassConstraint
classConstraint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ClassConstraint]
x)
                                             (Type -> Type
type' Type
y)


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
_                                           = []


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

qTypeCtor :: H.QTypeCtor -> P.QTypeCtor
qTypeCtor :: QTypeCtor -> QTypeCtor
qTypeCtor (H.QTypeCtor Maybe Module
x TypeCtor
y) = Maybe Module -> TypeCtor -> QTypeCtor
P.QTypeCtor (Module -> Module
module' 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. Map k a
Map.empty

typeVarMap :: Map String String
typeVarMap :: Map String String
typeVarMap = forall k a. Map k a
Map.empty