ocaml-export-0.5.0.0: Convert Haskell types in OCaml types

CopyrightPlow Technologies 2017
LicenseBSD3
Maintainermchaver@gmail.com
Stabilityexperimental
Safe HaskellNone
LanguageHaskell2010

OCaml.BuckleScript.Types

Description

OCaml datatype representation of a Haskell datatype. A recursive tree that can be interpreted to output OCaml code. It is meant to encode a Haskell type into OCaml and make json seraliazers that match the output from Generic aeson instances.

Synopsis

Documentation

data OCamlDatatype Source #

Top level of an OCaml datatype. A data type may be composed of primitives and/or a combination of constructors and primitives. OCamlDatatype is recursive via OCamlConstructor -> ValueConstructor -> OCamlValue -> OCamlPrimitive -> OCamlDatatype.

Constructors

OCamlDatatype HaskellTypeMetaData Text OCamlConstructor

The name of a type and its type constructor

OCamlPrimitive OCamlPrimitive

A primitive value

data OCamlConstructor Source #

OCamlConstructor take values to create a new instances of a type.

Constructors

OCamlValueConstructor ValueConstructor

Sum, record (product with named fields) or product without named fields

OCamlEnumeratorConstructor [EnumeratorConstructor]

Sum of enumerations only. If a sum contains enumerators and at least one constructor with a value then it is an OCamlValueConstructor

OCamlSumOfRecordConstructor Text ValueConstructor

Sum that contains at least one record. This construction is unique to Haskell. pIt has special Encoding and Decoding rules in order to output a valid OCaml program. i.e. `data A = A {a :: Int} | B {b :: String}`

data ValueConstructor Source #

OCamlConstructor of one RecordConstructor is a record type. OCamlConstructor of one NamedConstructor that has one value is a Haskell newtype. OCamlConstructor of one NamedConstructor is a product without field names. OCamlConstructor of multiple NamedConstructors is a sum type. OCamlConstructor of at least one RecordConstructor and any other amount of ValueConstructors greater than one is a OCamlSumWithRecordConstructor.

Constructors

NamedConstructor Text OCamlValue

Product without named fields

RecordConstructor Text OCamlValue

Product with named fields

MultipleConstructors [ValueConstructor]

Sum type

data OCamlValue Source #

Expected types of a constructor

Constructors

OCamlRef HaskellTypeMetaData Text

The name of a non-primitive data type

OCamlTypeParameterRef Text

Type parameters like a in `Maybe a`

OCamlEmpty

a place holder for OCaml value. It can represent the end of a list or an Enumerator in a mixed sum

OCamlPrimitiveRef OCamlPrimitive

A primitive OCaml type like int, string, etc.

OCamlField Text OCamlValue

A field name and its type from a record

Values OCamlValue OCamlValue

Used for multiple types in a sum type

class OCamlType a where Source #

Create an OCaml type from a Haskell type. Use the Generic definition when possible. It also expects ToJSON and FromJSON to be derived generically.

Methods

toOCamlType :: a -> OCamlDatatype Source #

toOCamlType :: (Generic a, GenericOCamlDatatype (Rep a)) => a -> OCamlDatatype Source #

Instances

OCamlType Bool Source # 
OCamlType Char Source # 
OCamlType Double Source # 
OCamlType Float Source # 
OCamlType Int Source # 
OCamlType Int8 Source # 
OCamlType Int16 Source # 
OCamlType Int32 Source # 
OCamlType Int64 Source # 
OCamlType Integer Source # 
OCamlType Word Source # 
OCamlType Word8 Source # 
OCamlType Word16 Source # 
OCamlType Word32 Source # 
OCamlType Word64 Source # 
OCamlType () Source # 
OCamlType ByteString Source # 
OCamlType Text Source # 
OCamlType UTCTime Source # 
OCamlType Day Source # 
OCamlType TypeParameterRef5 Source # 
OCamlType TypeParameterRef4 Source # 
OCamlType TypeParameterRef3 Source # 
OCamlType TypeParameterRef2 Source # 
OCamlType TypeParameterRef1 Source # 
OCamlType TypeParameterRef0 Source # 
OCamlType a => OCamlType [a] Source # 
OCamlType a => OCamlType (Maybe a) Source # 
(OCamlType l, OCamlType r) => OCamlType (Either l r) Source # 
(OCamlType a, OCamlType b) => OCamlType (a, b) Source # 

Methods

toOCamlType :: (a, b) -> OCamlDatatype Source #

OCamlType a => OCamlType (Proxy * a) Source # 
(OCamlType a, OCamlType b, OCamlType c) => OCamlType (a, b, c) Source # 

Methods

toOCamlType :: (a, b, c) -> OCamlDatatype Source #

(OCamlType a, OCamlType b, OCamlType c, OCamlType d) => OCamlType (a, b, c, d) Source # 

Methods

toOCamlType :: (a, b, c, d) -> OCamlDatatype Source #

(OCamlType a, OCamlType b, OCamlType c, OCamlType d, OCamlType e) => OCamlType (a, b, c, d, e) Source # 

Methods

toOCamlType :: (a, b, c, d, e) -> OCamlDatatype Source #

(OCamlType a, OCamlType b, OCamlType c, OCamlType d, OCamlType e, OCamlType f) => OCamlType (a, b, c, d, e, f) Source # 

Methods

toOCamlType :: (a, b, c, d, e, f) -> OCamlDatatype Source #

data TypeParameterRef0 Source #

Used to fill the type parameters of proxy types. `Proxy :: Proxy (Maybe TypeParameterRef0)`, `Proxy :: Proxy Either TypeParameterRef0 TypeParameterRef1`. JSON representation is as an Int to simplify the automated tests.

Instances

Eq TypeParameterRef0 Source # 
Read TypeParameterRef0 Source # 
Show TypeParameterRef0 Source # 
Generic TypeParameterRef0 Source # 
Arbitrary TypeParameterRef0 Source # 
ToJSON TypeParameterRef0 Source # 
FromJSON TypeParameterRef0 Source # 
ToADTArbitrary TypeParameterRef0 Source # 
OCamlType TypeParameterRef0 Source # 
type Rep TypeParameterRef0 Source # 
type Rep TypeParameterRef0 = D1 * (MetaData "TypeParameterRef0" "OCaml.BuckleScript.Types" "ocaml-export-0.5.0.0-2DxRIYGHFHxDqlSmQN9jmO" True) (C1 * (MetaCons "TypeParameterRef0" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Int)))

data TypeParameterRef1 Source #

Second unique TypeParameterRef.

Instances

Eq TypeParameterRef1 Source # 
Read TypeParameterRef1 Source # 
Show TypeParameterRef1 Source # 
Generic TypeParameterRef1 Source # 
Arbitrary TypeParameterRef1 Source # 
ToJSON TypeParameterRef1 Source # 
FromJSON TypeParameterRef1 Source # 
ToADTArbitrary TypeParameterRef1 Source # 
OCamlType TypeParameterRef1 Source # 
type Rep TypeParameterRef1 Source # 
type Rep TypeParameterRef1 = D1 * (MetaData "TypeParameterRef1" "OCaml.BuckleScript.Types" "ocaml-export-0.5.0.0-2DxRIYGHFHxDqlSmQN9jmO" True) (C1 * (MetaCons "TypeParameterRef1" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Int)))

data TypeParameterRef2 Source #

Third unique TypeParameterRef.

Instances

Eq TypeParameterRef2 Source # 
Read TypeParameterRef2 Source # 
Show TypeParameterRef2 Source # 
Generic TypeParameterRef2 Source # 
Arbitrary TypeParameterRef2 Source # 
ToJSON TypeParameterRef2 Source # 
FromJSON TypeParameterRef2 Source # 
ToADTArbitrary TypeParameterRef2 Source # 
OCamlType TypeParameterRef2 Source # 
type Rep TypeParameterRef2 Source # 
type Rep TypeParameterRef2 = D1 * (MetaData "TypeParameterRef2" "OCaml.BuckleScript.Types" "ocaml-export-0.5.0.0-2DxRIYGHFHxDqlSmQN9jmO" False) (C1 * (MetaCons "TypeParameterRef2" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Int)))

data TypeParameterRef3 Source #

Fourth unique TypeParameterRef.

Instances

Eq TypeParameterRef3 Source # 
Read TypeParameterRef3 Source # 
Show TypeParameterRef3 Source # 
Generic TypeParameterRef3 Source # 
Arbitrary TypeParameterRef3 Source # 
ToJSON TypeParameterRef3 Source # 
FromJSON TypeParameterRef3 Source # 
ToADTArbitrary TypeParameterRef3 Source # 
OCamlType TypeParameterRef3 Source # 
type Rep TypeParameterRef3 Source # 
type Rep TypeParameterRef3 = D1 * (MetaData "TypeParameterRef3" "OCaml.BuckleScript.Types" "ocaml-export-0.5.0.0-2DxRIYGHFHxDqlSmQN9jmO" False) (C1 * (MetaCons "TypeParameterRef3" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Int)))

data TypeParameterRef4 Source #

Fifth unique TypeParameterRef.

Instances

Eq TypeParameterRef4 Source # 
Read TypeParameterRef4 Source # 
Show TypeParameterRef4 Source # 
Generic TypeParameterRef4 Source # 
Arbitrary TypeParameterRef4 Source # 
ToJSON TypeParameterRef4 Source # 
FromJSON TypeParameterRef4 Source # 
ToADTArbitrary TypeParameterRef4 Source # 
OCamlType TypeParameterRef4 Source # 
type Rep TypeParameterRef4 Source # 
type Rep TypeParameterRef4 = D1 * (MetaData "TypeParameterRef4" "OCaml.BuckleScript.Types" "ocaml-export-0.5.0.0-2DxRIYGHFHxDqlSmQN9jmO" False) (C1 * (MetaCons "TypeParameterRef4" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Int)))

data TypeParameterRef5 Source #

Sixth unique TypeParameterRef.

Instances

Eq TypeParameterRef5 Source # 
Read TypeParameterRef5 Source # 
Show TypeParameterRef5 Source # 
Generic TypeParameterRef5 Source # 
Arbitrary TypeParameterRef5 Source # 
ToJSON TypeParameterRef5 Source # 
FromJSON TypeParameterRef5 Source # 
ToADTArbitrary TypeParameterRef5 Source # 
OCamlType TypeParameterRef5 Source # 
type Rep TypeParameterRef5 Source # 
type Rep TypeParameterRef5 = D1 * (MetaData "TypeParameterRef5" "OCaml.BuckleScript.Types" "ocaml-export-0.5.0.0-2DxRIYGHFHxDqlSmQN9jmO" False) (C1 * (MetaCons "TypeParameterRef5" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Int)))

getTypeParameterRefNames :: [OCamlValue] -> [Text] Source #

Convert OCamlValues to the type parameter names of a data type. `Either a0 a1` -> `["a0","a1"]`

getOCamlValues :: ValueConstructor -> [OCamlValue] Source #

getOCamlValues flatten the values from MultipleConstructors into a list and remove ValueConstructor.

isTypeParameterRef :: OCamlDatatype -> Bool Source #

Matches all of the TypeParameterRefs (TypeParameterRef0 to TypeParameterRef5). This function is needed to work around the tree structure for special rules for rendering type parameters.

mkModulePrefix :: OCamlTypeMetaData -> OCamlTypeMetaData -> Text Source #

Make OCaml module prefix for a value based on the declaration's and parameter's meta data.

oCamlValueIsFloat :: OCamlValue -> Bool Source #

BuckleScript has a float type that conflicts when you do 'open Aeson.Decode' float must be appended with Decode.