elm-street-0.0.0: Crossing the road between Haskell and Elm

Safe HaskellNone
LanguageHaskell2010

Elm.Generic

Contents

Description

Generic conversion of Haskell data types to Elm types.

Synopsis

Main data type for the user

class Elm a where Source #

Typeclass that describes how Haskell data types are converted to Elm ones.

Minimal complete definition

Nothing

Instances
Elm Bool Source # 
Instance details

Defined in Elm.Generic

Elm Char Source # 
Instance details

Defined in Elm.Generic

Elm Double Source # 
Instance details

Defined in Elm.Generic

Elm Float Source # 
Instance details

Defined in Elm.Generic

Elm Int Source # 
Instance details

Defined in Elm.Generic

Elm Int8 Source # 
Instance details

Defined in Elm.Generic

Elm Int16 Source # 
Instance details

Defined in Elm.Generic

Elm Int32 Source # 
Instance details

Defined in Elm.Generic

Elm Word Source # 
Instance details

Defined in Elm.Generic

Elm Word8 Source # 
Instance details

Defined in Elm.Generic

Elm Word16 Source # 
Instance details

Defined in Elm.Generic

Elm Word32 Source # 
Instance details

Defined in Elm.Generic

Elm () Source # 
Instance details

Defined in Elm.Generic

Elm Text Source # 
Instance details

Defined in Elm.Generic

Elm UTCTime Source # 
Instance details

Defined in Elm.Generic

Elm Text Source # 
Instance details

Defined in Elm.Generic

Elm String Source # 
Instance details

Defined in Elm.Generic

Elm Void Source # 
Instance details

Defined in Elm.Generic

Elm a => Elm [a] Source # 
Instance details

Defined in Elm.Generic

Elm a => Elm (Maybe a) Source # 
Instance details

Defined in Elm.Generic

Elm a => Elm (NonEmpty a) Source # 
Instance details

Defined in Elm.Generic

(HasNoTypeVars a, HasLessThanEightUnnamedFields a, HasNoNamedSum a, Generic a, GenericElmDefinition (Rep a)) => Elm (ElmStreet a) Source # 
Instance details

Defined in Elm.Aeson

(Elm a, Elm b) => Elm (Either a b) Source # 
Instance details

Defined in Elm.Generic

(Elm a, Elm b) => Elm (a, b) Source # 
Instance details

Defined in Elm.Generic

elmRef :: forall a. Elm a => TypeRef Source #

Returns TypeRef for the existing type. This function always returns the name of the type without any type variables added.

Smart constructors

elmNewtype :: forall a. Elm a => Text -> Text -> ElmDefinition Source #

This function can be used to create manual Elm instances easily for newtypes where Generic deriving doesn't work. This function can be used like this:

newtype Id a = Id { unId :: Text }

instance Elm (Id a) where
    toElmDefinition _ = elmNewtype @Text Id "unId"

Generic utilities

class GenericElmDefinition (f :: k -> Type) where Source #

Generic typeclass to generate whole ElmDefinition. It has only one instance: for the first top-level metadata that contains metainformation about data type like data type name. Then it collects all constructors of the data type and decides what to generate.

Instances
(Datatype d, GenericElmConstructors f) => GenericElmDefinition (D1 d f :: k -> Type) Source # 
Instance details

Defined in Elm.Generic

class GenericElmConstructors (f :: k -> Type) where Source #

Typeclass to collect all constructors of the Haskell data type generically.

Methods

genericToElmConstructors Source #

Arguments

:: TypeName

Name of the data type; to be stripped

-> f a

Generic value

-> NonEmpty GenericConstructor

List of the data type constructors

Instances
(GenericElmConstructors f, GenericElmConstructors g) => GenericElmConstructors (f :+: g :: k -> Type) Source #

If it's a sum type then just combine constructors

Instance details

Defined in Elm.Generic

(Constructor c, GenericElmFields f) => GenericElmConstructors (C1 c f :: k -> Type) Source #

Create singleton list for case of a one constructor.

Instance details

Defined in Elm.Generic

class GenericElmFields (f :: k -> Type) where Source #

Collect all fields when inside constructor.

Methods

genericToElmFields Source #

Arguments

:: TypeName

Name of the data type; to be stripped

-> f a

Generic value

-> [(TypeRef, Maybe Text)] 
Instances
GenericElmFields (U1 :: k -> Type) Source #

Constructor without fields.

Instance details

Defined in Elm.Generic

(GenericElmFields f, GenericElmFields g) => GenericElmFields (f :*: g :: k -> Type) Source #

If multiple fields then just combine all results.

Instance details

Defined in Elm.Generic

Methods

genericToElmFields :: TypeName -> (f :*: g) a -> [(TypeRef, Maybe Text)] Source #

(Selector s, Elm a) => GenericElmFields (S1 s (Rec0 a) :: k -> Type) Source #

Single constructor field.

Instance details

Defined in Elm.Generic

Methods

genericToElmFields :: TypeName -> S1 s (Rec0 a) a0 -> [(TypeRef, Maybe Text)] Source #

data GenericConstructor Source #

Intermediate data type to help with the conversion from Haskell constructors to Elm AST. In Haskell constructor fields may have names but may not have.

toElmConstructor :: GenericConstructor -> Either (NonEmpty ElmRecordField) ElmConstructor Source #

Generic constructor can be in one of the three states:

  1. No fields: enum constructor.
  2. All fields have names: record constructor.
  3. Not all fields have names: plain constructor.

Type families for compile-time checks

type family HasNoTypeVars (f :: k) :: Constraint where ... Source #

This type family checks whether data type has type variables and throws custom compiler error if it has. Since there's no generic way to get all type variables, current implementation is limited only to 6 variables. This looks like a reasonable number.

Equations

HasNoTypeVars (t a b c d e f) = TypeError (TypeVarsError t 6) 
HasNoTypeVars (t a b c d e) = TypeError (TypeVarsError t 5) 
HasNoTypeVars (t a b c d) = TypeError (TypeVarsError t 4) 
HasNoTypeVars (t a b c) = TypeError (TypeVarsError t 3) 
HasNoTypeVars (t a b) = TypeError (TypeVarsError t 2) 
HasNoTypeVars (t a) = TypeError (TypeVarsError t 1) 
HasNoTypeVars t = () 

type family TypeVarsError (t :: k) (n :: Nat) :: ErrorMessage where ... Source #

Equations

TypeVarsError t n = ((((Text "'elm-street' currently doesn't support Generic deriving of the 'Elm' typeclass" :$$: ((((Text "for data types with type variables. But '" :<>: ShowType t) :<>: Text "' has ") :<>: ShowType n) :<>: Text " variables.")) :$$: Text "") :$$: Text "See the following issue for more details:") :$$: Text " * https://github.com/Holmusk/elm-street/issues/45") :$$: Text "" 

type family HasLessThanEightUnnamedFields (f :: k) :: Constraint where ... Source #

This type family checks whether each constructor of the sum data type has less than eight unnamed fields and throws custom compiler error if it has.

type family FieldsError (t :: k) :: ErrorMessage where ... Source #

Equations

FieldsError t = Text "'elm-street' doesn't support Constructors with more than 8 unnamed fields." :$$: ((Text "But '" :<>: ShowType t) :<>: Text "' has more.") 

type family CheckFields (f :: k -> Type) :: Nat where ... Source #

Equations

CheckFields (D1 _ f) = CheckFields f 
CheckFields (f :+: g) = Max (CheckFields f) (CheckFields g) 
CheckFields (C1 _ f) = CheckFields f 
CheckFields (f :*: g) = CheckFields f + CheckFields g 
CheckFields (S1 (MetaSel (Just _) _ _ _) _) = 0 
CheckFields (S1 _ _) = 1 
CheckFields _ = 0 

type family Max (x :: Nat) (y :: Nat) :: Nat where ... Source #

Equations

Max x y = If (x <=? y) y x 

type family HasNoNamedSum (f :: k) :: Constraint where ... Source #

This type family checks whether each constructor of the sum data type has less than eight unnamed fields and throws custom compiler error if it has.

type family NamedSumError (t :: k) :: ErrorMessage where ... Source #

Equations

NamedSumError t = Text "'elm-street' doesn't support Sum types with records." :$$: ((Text "But '" :<>: ShowType t) :<>: Text "' has records.") 

type family CheckNamedSum (f :: k -> Type) :: Bool where ... Source #

Is the data type id Sum type with named fields?

type family CheckConst (f :: k -> Type) :: Bool where ... Source #

Check if Sum type has named fields at least for one of the Constructors.

Equations

CheckConst (f :+: g) = CheckConst f || CheckConst g 
CheckConst (C1 _ f) = CheckConst f 
CheckConst (S1 (MetaSel (Just _) _ _ _) _) = True 
CheckConst (f :*: g) = CheckConst f || CheckConst g 
CheckConst _ = False 

Internals

stripTypeNamePrefix :: TypeName -> Text -> Text Source #

Strips name of the type name from field name prefix.

>>> stripTypeNamePrefix (TypeName "User") "userName"
"name"
>>> stripTypeNamePrefix (TypeName "HealthReading") "healthReadingId"
"id"
>>> stripTypeNamePrefix (TypeName "RecordUpdate") "ruRows"
"rows"
>>> stripTypeNamePrefix (TypeName "Foo") "foo"
"foo"
>>> stripTypeNamePrefix (TypeName "Foo") "abc"
"abc"