module Hydra.Ext.Scala.Prepare (
  prepareType,
) where

import Hydra.All
import qualified Hydra.Impl.Haskell.Dsl.Types as Types

import qualified Data.Set as S


prepareLiteralType :: LiteralType -> (LiteralType, Literal -> Literal, S.Set String)
prepareLiteralType :: LiteralType -> (LiteralType, Literal -> Literal, Set String)
prepareLiteralType LiteralType
at = case LiteralType
at of
  LiteralType
LiteralTypeBinary -> forall a b. a -> String -> String -> b -> (a, b, Set String)
subst LiteralType
LiteralTypeString
    String
"binary strings" String
"character strings"
    forall a b. (a -> b) -> a -> b
$ \(LiteralBinary String
v) -> String -> Literal
LiteralString String
v
  LiteralTypeFloat FloatType
ft -> (FloatType -> LiteralType
LiteralTypeFloat FloatType
rtyp, \(LiteralFloat FloatValue
v) -> FloatValue -> Literal
LiteralFloat forall a b. (a -> b) -> a -> b
$ FloatValue -> FloatValue
rep FloatValue
v, Set String
msgs)
    where
      (FloatType
rtyp, FloatValue -> FloatValue
rep, Set String
msgs) = FloatType -> (FloatType, FloatValue -> FloatValue, Set String)
prepareFloatType FloatType
ft
  LiteralTypeInteger IntegerType
it -> (IntegerType -> LiteralType
LiteralTypeInteger IntegerType
rtyp, \(LiteralInteger IntegerValue
v) -> IntegerValue -> Literal
LiteralInteger forall a b. (a -> b) -> a -> b
$ IntegerValue -> IntegerValue
rep IntegerValue
v, Set String
msgs)
    where
      (IntegerType
rtyp, IntegerValue -> IntegerValue
rep, Set String
msgs) = IntegerType
-> (IntegerType, IntegerValue -> IntegerValue, Set String)
prepareIntegerType IntegerType
it
  LiteralType
_ -> forall a b c. a -> (a, b -> b, Set c)
same LiteralType
at

prepareFloatType :: FloatType -> (FloatType, FloatValue -> FloatValue, S.Set String)
prepareFloatType :: FloatType -> (FloatType, FloatValue -> FloatValue, Set String)
prepareFloatType FloatType
ft = case FloatType
ft of
  FloatType
FloatTypeBigfloat -> forall a b. a -> String -> String -> b -> (a, b, Set String)
subst FloatType
FloatTypeFloat64
    String
"arbitrary-precision floating-point numbers" String
"64-bit floating-point numbers (doubles)"
    forall a b. (a -> b) -> a -> b
$ \(FloatValueBigfloat Double
v) -> Double -> FloatValue
FloatValueFloat64 Double
v
  FloatType
_ -> forall a b c. a -> (a, b -> b, Set c)
same FloatType
ft

prepareIntegerType :: IntegerType -> (IntegerType, IntegerValue -> IntegerValue, S.Set String)
prepareIntegerType :: IntegerType
-> (IntegerType, IntegerValue -> IntegerValue, Set String)
prepareIntegerType IntegerType
it = case IntegerType
it of
  IntegerType
IntegerTypeBigint -> forall a b. a -> String -> String -> b -> (a, b, Set String)
subst IntegerType
IntegerTypeInt64
    String
"arbitrary-precision integers" String
"64-bit integers"
    forall a b. (a -> b) -> a -> b
$ \(IntegerValueBigint Integer
v) -> Integer -> IntegerValue
IntegerValueInt64 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v
  IntegerType
IntegerTypeUint8 -> forall a b. a -> String -> String -> b -> (a, b, Set String)
subst IntegerType
IntegerTypeInt8
    String
"unsigned 8-bit integers" String
"signed 8-bit integers"
    forall a b. (a -> b) -> a -> b
$ \(IntegerValueUint8 Int
v) -> Int -> IntegerValue
IntegerValueInt8 Int
v
  IntegerType
IntegerTypeUint32 -> forall a b. a -> String -> String -> b -> (a, b, Set String)
subst IntegerType
IntegerTypeInt32
    String
"unsigned 32-bit integers" String
"signed 32-bit integers"
    forall a b. (a -> b) -> a -> b
$ \(IntegerValueUint32 Integer
v) -> Int -> IntegerValue
IntegerValueInt32 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
v
  IntegerType
IntegerTypeUint64 -> forall a b. a -> String -> String -> b -> (a, b, Set String)
subst IntegerType
IntegerTypeInt64
    String
"unsigned 64-bit integers" String
"signed 64-bit integers"
    forall a b. (a -> b) -> a -> b
$ \(IntegerValueUint64 Integer
v) -> Integer -> IntegerValue
IntegerValueInt64 Integer
v
  IntegerType
_ -> forall a b c. a -> (a, b -> b, Set c)
same IntegerType
it

prepareType :: Context m -> Type m -> (Type m, Term m -> Term m, S.Set String)
prepareType :: forall m.
Context m -> Type m -> (Type m, Term m -> Term m, Set String)
prepareType Context m
cx Type m
typ = case forall m. Type m -> Type m
stripType Type m
typ of
  TypeLiteral LiteralType
at -> (forall m. LiteralType -> Type m
Types.literal LiteralType
rtyp, \(TermLiteral Literal
av) -> forall m. Literal -> Term m
TermLiteral forall a b. (a -> b) -> a -> b
$ Literal -> Literal
rep Literal
av, Set String
msgs)
    where
      (LiteralType
rtyp, Literal -> Literal
rep, Set String
msgs) = LiteralType -> (LiteralType, Literal -> Literal, Set String)
prepareLiteralType LiteralType
at
--  TypeElement et ->
--  TypeFunction (FunctionType dom cod) ->
--  TypeList lt ->
--  TypeMap (MapType kt vt) ->
--  TypeNominal name ->
--  TypeRecord fields ->
--  TypeSet st ->
--  TypeUnion fields ->

same :: a -> (a, b -> b, S.Set c)
same :: forall a b c. a -> (a, b -> b, Set c)
same a
x = (a
x, forall a. a -> a
id, forall a. Set a
S.empty)

subst :: a -> [Char] -> [Char] -> b -> (a, b, S.Set [Char])
subst :: forall a b. a -> String -> String -> b -> (a, b, Set String)
subst a
t String
from String
to b
r = (a
t, b
r, forall a. Ord a => [a] -> Set a
S.fromList [String
"replace " forall a. [a] -> [a] -> [a]
++ String
from forall a. [a] -> [a] -> [a]
++ String
" with " forall a. [a] -> [a] -> [a]
++ String
to])