-- | A DSL for constructing literal terms using Haskell's built-in datatypes

module Hydra.Impl.Haskell.Dsl.PhantomLiterals where

import Hydra.Kernel
import qualified Hydra.Impl.Haskell.Dsl.Terms as Terms
import Data.Int


-- Note: does not yet properly capture arbitrary-precision floating-point numbers,
--       because code generation does not.
type Bigfloat = Double

-- Note: does not distinguish Binary from String, because code generation does not.
type Binary = String

bigfloat :: Bigfloat -> Datum Bigfloat
bigfloat :: Bigfloat -> Datum Bigfloat
bigfloat = forall a. Term Meta -> Datum a
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Bigfloat -> Term m
Terms.bigfloat

bigint :: Integer -> Datum Integer
bigint :: Integer -> Datum Integer
bigint = forall a. Term Meta -> Datum a
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Integer -> Term m
Terms.bigint

binary :: Binary -> Datum Binary
binary :: Binary -> Datum Binary
binary = forall a. Term Meta -> Datum a
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Binary -> Term m
Terms.binary

bool :: Bool -> Datum Bool
bool :: Bool -> Datum Bool
bool = forall a. Term Meta -> Datum a
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Bool -> Term m
Terms.boolean

boolean :: Bool -> Datum Bool
boolean :: Bool -> Datum Bool
boolean = Bool -> Datum Bool
bool

double :: Double -> Datum Double
double :: Bigfloat -> Datum Bigfloat
double = Bigfloat -> Datum Bigfloat
float64

false :: Datum Bool
false :: Datum Bool
false = Bool -> Datum Bool
bool Bool
False

float :: Float -> Datum Float
float :: Float -> Datum Float
float = Float -> Datum Float
float32

float32 :: Float -> Datum Float
float32 :: Float -> Datum Float
float32 = forall a. Term Meta -> Datum a
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Float -> Term m
Terms.float32

float64 :: Double -> Datum Double
float64 :: Bigfloat -> Datum Bigfloat
float64 = forall a. Term Meta -> Datum a
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Bigfloat -> Term m
Terms.float64

int :: Int -> Datum Int
int :: Int -> Datum Int
int = Int -> Datum Int
int32

int8 :: Int8 -> Datum Int8
int8 :: Int8 -> Datum Int8
int8 = forall a. Term Meta -> Datum a
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Int8 -> Term m
Terms.int8

int16 :: Int16 -> Datum Int16
int16 :: Int16 -> Datum Int16
int16 = forall a. Term Meta -> Datum a
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Int16 -> Term m
Terms.int16

int32 :: Int -> Datum Int
int32 :: Int -> Datum Int
int32 = forall a. Term Meta -> Datum a
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Int -> Term m
Terms.int32

int64 :: Int64 -> Datum Int64
int64 :: Int64 -> Datum Int64
int64 = forall a. Term Meta -> Datum a
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Int64 -> Term m
Terms.int64

string :: String -> Datum String
string :: Binary -> Datum Binary
string = forall a. Term Meta -> Datum a
Datum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Binary -> Term m
Terms.string

true :: Datum Bool
true :: Datum Bool
true = Bool -> Datum Bool
bool Bool
True

-- Note: untyped integers are not yet properly supported by the DSL,
--       because they are not properly supported by code generation.
uint8 :: Int8 -> Datum Int8
uint8 :: Int8 -> Datum Int8
uint8 = Int8 -> Datum Int8
int8
uint16 :: Int16 -> Datum Int16
uint16 :: Int16 -> Datum Int16
uint16 = Int16 -> Datum Int16
int16
uint32 :: Int -> Datum Int
uint32 :: Int -> Datum Int
uint32 = Int -> Datum Int
int
uint64 :: Int64 -> Datum Int64
uint64 :: Int64 -> Datum Int64
uint64 = Int64 -> Datum Int64
int64