-- | A DSL for constructing Hydra types

module Hydra.Impl.Haskell.Dsl.Types where

import Hydra.Kernel

import qualified Data.List as L
import qualified Data.Map as M
import Data.String(IsString(..))


instance IsString (Type m) where fromString :: String -> Type m
fromString = forall m. String -> Type m
variable

infixr 0 >:
(>:) :: String -> Type m -> FieldType m
String
n >: :: forall m. String -> Type m -> FieldType m
>: Type m
t = forall m. String -> Type m -> FieldType m
field String
n Type m
t

infixr 0 -->
(-->) :: Type m -> Type m -> Type m
Type m
a --> :: forall m. Type m -> Type m -> Type m
--> Type m
b = forall m. Type m -> Type m -> Type m
function Type m
a Type m
b

(@@) :: Type m -> Type m -> Type m
Type m
f @@ :: forall m. Type m -> Type m -> Type m
@@ Type m
x = forall m. Type m -> Type m -> Type m
apply Type m
f Type m
x

annot :: m -> Type m -> Type m
annot :: forall m. m -> Type m -> Type m
annot m
ann Type m
t = forall m. Annotated (Type m) m -> Type m
TypeAnnotated forall a b. (a -> b) -> a -> b
$ forall a m. a -> m -> Annotated a m
Annotated Type m
t m
ann

apply :: Type m -> Type m -> Type m
apply :: forall m. Type m -> Type m -> Type m
apply Type m
lhs Type m
rhs = forall m. ApplicationType m -> Type m
TypeApplication (forall m. Type m -> Type m -> ApplicationType m
ApplicationType Type m
lhs Type m
rhs)

bigfloat :: Type m
bigfloat :: forall m. Type m
bigfloat = forall m. FloatType -> Type m
float FloatType
FloatTypeBigfloat

bigint :: Type m
bigint :: forall m. Type m
bigint = forall m. IntegerType -> Type m
integer IntegerType
IntegerTypeBigint

binary :: Type m
binary :: forall m. Type m
binary = forall m. LiteralType -> Type m
literal LiteralType
LiteralTypeBinary

boolean :: Type m
boolean :: forall m. Type m
boolean = forall m. LiteralType -> Type m
literal LiteralType
LiteralTypeBoolean

element :: Type m -> Type m
element :: forall m. Type m -> Type m
element = forall m. Type m -> Type m
TypeElement

enum :: [String] -> Type m
enum :: forall m. [String] -> Type m
enum [String]
names = forall m. [FieldType m] -> Type m
union forall a b. (a -> b) -> a -> b
$ (forall m. String -> Type m -> FieldType m
`field` forall m. Type m
unit) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
names

field :: String -> Type m -> FieldType m
field :: forall m. String -> Type m -> FieldType m
field String
fn = forall m. FieldName -> Type m -> FieldType m
FieldType (String -> FieldName
FieldName String
fn)

fieldsToMap :: [FieldType m] -> M.Map FieldName (Type m)
fieldsToMap :: forall m. [FieldType m] -> Map FieldName (Type m)
fieldsToMap [FieldType m]
fields = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ (\(FieldType FieldName
name Type m
typ) -> (FieldName
name, Type m
typ)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FieldType m]
fields

float32 :: Type m
float32 :: forall m. Type m
float32 = forall m. FloatType -> Type m
float FloatType
FloatTypeFloat32

float64 :: Type m
float64 :: forall m. Type m
float64 = forall m. FloatType -> Type m
float FloatType
FloatTypeFloat64

float :: FloatType -> Type m
float :: forall m. FloatType -> Type m
float = forall m. LiteralType -> Type m
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. FloatType -> LiteralType
LiteralTypeFloat

function :: Type m -> Type m -> Type m
function :: forall m. Type m -> Type m -> Type m
function Type m
dom Type m
cod = forall m. FunctionType m -> Type m
TypeFunction forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m -> FunctionType m
FunctionType Type m
dom Type m
cod

functionN :: [Type m] -> Type m -> Type m
functionN :: forall m. [Type m] -> Type m -> Type m
functionN [Type m]
doms Type m
cod = if forall (t :: * -> *) a. Foldable t => t a -> Bool
L.null [Type m]
doms
  then Type m
cod
  else forall m. Type m -> Type m -> Type m
function (forall a. [a] -> a
L.head [Type m]
doms) forall a b. (a -> b) -> a -> b
$ forall m. [Type m] -> Type m -> Type m
functionN (forall a. [a] -> [a]
L.tail [Type m]
doms) Type m
cod

int16 :: Type m
int16 :: forall m. Type m
int16 = forall m. IntegerType -> Type m
integer IntegerType
IntegerTypeInt16

int32 :: Type m
int32 :: forall m. Type m
int32 = forall m. IntegerType -> Type m
integer IntegerType
IntegerTypeInt32

int64 :: Type m
int64 :: forall m. Type m
int64 = forall m. IntegerType -> Type m
integer IntegerType
IntegerTypeInt64

int8 :: Type m
int8 :: forall m. Type m
int8 = forall m. IntegerType -> Type m
integer IntegerType
IntegerTypeInt8

integer :: IntegerType -> Type m
integer :: forall m. IntegerType -> Type m
integer = forall m. LiteralType -> Type m
literal forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntegerType -> LiteralType
LiteralTypeInteger

lambda :: String -> Type m -> Type m
lambda :: forall m. String -> Type m -> Type m
lambda String
v Type m
body = forall m. LambdaType m -> Type m
TypeLambda forall a b. (a -> b) -> a -> b
$ forall m. VariableType -> Type m -> LambdaType m
LambdaType (String -> VariableType
VariableType String
v) Type m
body

list :: Type m -> Type m
list :: forall m. Type m -> Type m
list = forall m. Type m -> Type m
TypeList

isUnit :: Eq m => Type m -> Bool
isUnit :: forall m. Eq m => Type m -> Bool
isUnit Type m
t = forall m. Type m -> Type m
stripType Type m
t forall a. Eq a => a -> a -> Bool
== forall m. RowType m -> Type m
TypeRecord (forall m. Name -> Maybe Name -> [FieldType m] -> RowType m
RowType Name
unitTypeName forall a. Maybe a
Nothing [])

literal :: LiteralType -> Type m
literal :: forall m. LiteralType -> Type m
literal = forall m. LiteralType -> Type m
TypeLiteral

map :: Type m -> Type m -> Type m
map :: forall m. Type m -> Type m -> Type m
map Type m
kt Type m
vt = forall m. MapType m -> Type m
TypeMap forall a b. (a -> b) -> a -> b
$ forall m. Type m -> Type m -> MapType m
MapType Type m
kt Type m
vt

nominal :: Name -> Type m
nominal :: forall m. Name -> Type m
nominal = forall m. Name -> Type m
TypeNominal

optional :: Type m -> Type m
optional :: forall m. Type m -> Type m
optional = forall m. Type m -> Type m
TypeOptional

product :: [Type m] -> Type m
product :: forall m. [Type m] -> Type m
product = forall m. [Type m] -> Type m
TypeProduct

record :: [FieldType m] -> Type m
record :: forall m. [FieldType m] -> Type m
record [FieldType m]
fields = forall m. RowType m -> Type m
TypeRecord forall a b. (a -> b) -> a -> b
$ forall m. Name -> Maybe Name -> [FieldType m] -> RowType m
RowType Name
placeholderName forall a. Maybe a
Nothing [FieldType m]
fields

set :: Type m -> Type m
set :: forall m. Type m -> Type m
set = forall m. Type m -> Type m
TypeSet

string :: Type m
string :: forall m. Type m
string = forall m. LiteralType -> Type m
literal LiteralType
LiteralTypeString

sum :: [Type m] -> Type m
sum :: forall m. [Type m] -> Type m
sum = forall m. [Type m] -> Type m
TypeSum

uint16 :: Type m
uint16 :: forall m. Type m
uint16 = forall m. IntegerType -> Type m
integer IntegerType
IntegerTypeUint16

uint32 :: Type m
uint32 :: forall m. Type m
uint32 = forall m. IntegerType -> Type m
integer IntegerType
IntegerTypeUint32

uint64 :: Type m
uint64 :: forall m. Type m
uint64 = forall m. IntegerType -> Type m
integer IntegerType
IntegerTypeUint64

uint8 :: Type m
uint8 :: forall m. Type m
uint8 = forall m. IntegerType -> Type m
integer IntegerType
IntegerTypeUint8

union :: [FieldType m] -> Type m
union :: forall m. [FieldType m] -> Type m
union [FieldType m]
fields = forall m. RowType m -> Type m
TypeUnion forall a b. (a -> b) -> a -> b
$ forall m. Name -> Maybe Name -> [FieldType m] -> RowType m
RowType Name
placeholderName forall a. Maybe a
Nothing [FieldType m]
fields

unit :: Type m
unit :: forall m. Type m
unit = forall m. RowType m -> Type m
TypeRecord forall a b. (a -> b) -> a -> b
$ forall m. Name -> Maybe Name -> [FieldType m] -> RowType m
RowType (String -> Name
Name String
"hydra/core.UnitType") forall a. Maybe a
Nothing []

variable :: String -> Type m
variable :: forall m. String -> Type m
variable = forall m. VariableType -> Type m
TypeVariable forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> VariableType
VariableType