module Hydra.Ext.Scala.Utils where

import Hydra.Kernel
import qualified Hydra.Ext.Scala.Meta as Scala
import qualified Hydra.Lib.Strings as Strings
import Hydra.Ext.Scala.Language

import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Maybe as Y


nameOfType :: Context m -> Type m -> Y.Maybe Name
nameOfType :: forall m. Context m -> Type m -> Maybe Name
nameOfType Context m
cx Type m
t = case forall m. Type m -> Type m
stripType Type m
t of
  TypeNominal Name
name -> forall a. a -> Maybe a
Just Name
name
  TypeLambda (LambdaType VariableType
_ Type m
body) -> forall m. Context m -> Type m -> Maybe Name
nameOfType Context m
cx Type m
body
  Type m
_ -> forall a. Maybe a
Nothing

qualifyUnionFieldName :: String -> Y.Maybe Name -> FieldName -> String
qualifyUnionFieldName :: String -> Maybe Name -> FieldName -> String
qualifyUnionFieldName String
dlft Maybe Name
sname (FieldName String
fname) = (forall b a. b -> (a -> b) -> Maybe a -> b
Y.maybe String
dlft (\Name
n -> Bool -> Name -> String
scalaTypeName Bool
True Name
n forall a. [a] -> [a] -> [a]
++ String
".") Maybe Name
sname) forall a. [a] -> [a] -> [a]
++ String
fname

scalaTypeName :: Bool -> Name -> String
scalaTypeName :: Bool -> Name -> String
scalaTypeName Bool
qualify name :: Name
name@(Name String
n) = if Bool
qualify Bool -> Bool -> Bool
|| forall a. Ord a => a -> Set a -> Bool
S.member String
local Set String
reservedWords
    then forall a. [a] -> [[a]] -> [a]
L.intercalate String
"." forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
Strings.splitOn String
"/" String
n
    else String
local
  where
    (Namespace
_, String
local) = Name -> (Namespace, String)
toQnameLazy Name
name

sapply :: Scala.Data -> [Scala.Data] -> Scala.Data
sapply :: Data -> [Data] -> Data
sapply Data
fun [Data]
args = Data_Apply -> Data
Scala.DataApply forall a b. (a -> b) -> a -> b
$ Data -> [Data] -> Data_Apply
Scala.Data_Apply Data
fun [Data]
args

sassign :: Scala.Data -> Scala.Data -> Scala.Data
sassign :: Data -> Data -> Data
sassign Data
lhs Data
rhs = Data_Assign -> Data
Scala.DataAssign forall a b. (a -> b) -> a -> b
$ Data -> Data -> Data_Assign
Scala.Data_Assign Data
lhs Data
rhs

slambda :: String -> Scala.Data -> Y.Maybe Scala.Type -> Scala.Data
slambda :: String -> Data -> Maybe Type -> Data
slambda String
v Data
body Maybe Type
sdom = Data_FunctionData -> Data
Scala.DataFunctionData forall a b. (a -> b) -> a -> b
$ Data_Function -> Data_FunctionData
Scala.Data_FunctionDataFunction
    forall a b. (a -> b) -> a -> b
$ [Data_Param] -> Data -> Data_Function
Scala.Data_Function [[Mod] -> Name -> Maybe Type -> Maybe Data -> Data_Param
Scala.Data_Param forall {a}. [a]
mods Name
name Maybe Type
sdom forall a. Maybe a
def] Data
body
  where
    mods :: [a]
mods = []
    name :: Name
name = String -> Name
Scala.NameValue String
v
    def :: Maybe a
def = forall a. Maybe a
Nothing

sname :: String -> Scala.Data
sname :: String -> Data
sname = Data_Ref -> Data
Scala.DataRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data_Name -> Data_Ref
Scala.Data_RefName forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredefString -> Data_Name
Scala.Data_Name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PredefString
Scala.PredefString

sprim :: Name -> Scala.Data
sprim :: Name -> Data
sprim Name
name = String -> Data
sname forall a b. (a -> b) -> a -> b
$ String
prefix forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
local
  where
    (Namespace String
ns, String
local) = Name -> (Namespace, String)
toQnameLazy Name
name
    prefix :: String
prefix = forall a. [a] -> a
L.last forall a b. (a -> b) -> a -> b
$ String -> String -> [String]
Strings.splitOn String
"/" String
ns

stapply :: Scala.Type -> [Scala.Type] -> Scala.Type
stapply :: Type -> [Type] -> Type
stapply Type
t [Type]
args = Type_Apply -> Type
Scala.TypeApply forall a b. (a -> b) -> a -> b
$ Type -> [Type] -> Type_Apply
Scala.Type_Apply Type
t [Type]
args

stapply1 :: Scala.Type -> Scala.Type -> Scala.Type
stapply1 :: Type -> Type -> Type
stapply1 Type
t1 Type
t2 = Type -> [Type] -> Type
stapply Type
t1 [Type
t2]

stapply2 :: Scala.Type -> Scala.Type -> Scala.Type -> Scala.Type
stapply2 :: Type -> Type -> Type -> Type
stapply2 Type
t1 Type
t2 Type
t3 = Type -> [Type] -> Type
stapply Type
t1 [Type
t2, Type
t3]

stparam :: VariableType -> Scala.Type_Param
stparam :: VariableType -> Type_Param
stparam (VariableType String
v) = [Mod]
-> Name
-> [Type_Param]
-> [Type_Bounds]
-> [Type]
-> [Type]
-> Type_Param
Scala.Type_Param [] (String -> Name
Scala.NameValue String
v) [] [] [] []

stref :: String -> Scala.Type
stref :: String -> Type
stref = Type_Ref -> Type
Scala.TypeRef forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type_Name -> Type_Ref
Scala.Type_RefName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Type_Name
Scala.Type_Name

svar :: Variable -> Scala.Pat
svar :: Variable -> Pat
svar (Variable String
v) = (Pat_Var -> Pat
Scala.PatVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data_Name -> Pat_Var
Scala.Pat_Var forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredefString -> Data_Name
Scala.Data_Name forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PredefString
Scala.PredefString) String
v