core_external_language_haskell.pureToHaskell.pure Maven / Gradle / Ivy

Go to download
Show more of this group Show more artifacts with this name
Show all versions of legend-engine-xt-haskell-pure Show documentation
The newest version!
import meta::external::language::haskell::metamodel::*;
import meta::external::language::haskell::transformation::fromPure::*;

function meta::external::language::haskell::transformation::fromPure::haskellFromPureElements(elements:PackageableElement[1..*]):HaskellModule[*]
{
  $elements->haskellFromPureElements(buildDefaultPrimitiveTypesMap());
}

function meta::external::language::haskell::transformation::fromPure::haskellFromPureElements(inputs:PackageableElement[1..*],primTypes:Map[1]):HaskellModule[*]
{
  let elements = $inputs->map( i | $i->selectTransformableElements());
  let classes = $elements->filter(e | $e->instanceOf(Class))->cast(@Class);
  let types = $classes->fold({t,l|$l->concatenate($t->scanTypes($l))}, []);
  let typesByPackage = $types->groupBy(t | $t->cast(@PackageableElement).package->toOne());
  let typesMap = seedTypes($types, $primTypes);
  let defaultDerivings = ^Deriving(types=[^NamedTypeRef(name='Eq'),^NamedTypeRef(name='Ord'),^NamedTypeRef(name='Show')]);
  $typesByPackage->keyValues()->map(p|haskellModuleFromPurePackageElements($p.first,$p.second.values,$typesMap,$defaultDerivings));
}

function meta::external::language::haskell::transformation::fromPure::selectTransformableElements(e:PackageableElement[1]):PackageableElement[*]
{
  $e->match([
    p:Package[1] | $p->getAllPackageElements(true)->map(pe | $pe->selectTransformableElements()),
    c:Class[1] | $c,
    e:Enumeration[1] | $e,
    a:Any[1] | []
  ])
}

function meta::external::language::haskell::transformation::fromPure::haskellModuleFromPurePackageElements(p:Package[1],elements:Type[*],typesMap:Map[1], deriving:Deriving[*]):HaskellModule[1]
{
  let decls = transformPureTypesToHaskell($elements, $typesMap, $deriving);
  ^HaskellModule(id=$p->purePackageToHaskellModuleName(),elements=$decls);
}

function meta::external::language::haskell::transformation::fromPure::purePackageToHaskellModuleName(p:Package[1]):String[1]
{
  let path = $p->elementPath()->tail().name->map(s | $s->toUpperFirstCharacter());
  $path->joinStrings('.');
}

function meta::external::language::haskell::transformation::fromPure::scanTypes(t:Type[1], processed:Type[*]):Type[*]
{
   let r = if (!$processed->contains($t),
       |$t->concatenate(if($t->instanceOf(Class),
                         |$t->cast(@Class)->allProperties().genericType.rawType->distinct()
                            ->concatenate($t->cast(@Class)->meta::pure::functions::meta::findAllSpecializations())
                            ->filter(t|($t->instanceOf(Class) || $t->instanceOf(meta::pure::metamodel::type::Enumeration)) && $t != Any)
                            ->map(c|$c->meta::external::language::haskell::transformation::fromPure::scanTypes($processed->concatenate($t)))->distinct(),
                         |[]
                       )),
       |[]
   );
   $r;
}

function meta::external::language::haskell::transformation::fromPure::buildDefaultPrimitiveTypesMap():Map[1]
{
  newMap(
      [
         pair(Integer, ^meta::external::language::haskell::metamodel::Int()),
         pair(Float, ^meta::external::language::haskell::metamodel::Double()),
         pair(Decimal, ^meta::external::language::haskell::metamodel::Decimal()),
         pair(String, ^meta::external::language::haskell::metamodel::Text()),
         pair(Boolean, ^meta::external::language::haskell::metamodel::Bool()),
         pair(DateTime , ^meta::external::language::haskell::metamodel::DateTime()),
         //pair(Date , 'TODO'),
         //pair(StrictDate , 'TODO'),
         pair(Number , ^meta::external::language::haskell::metamodel::Num())
      ])
}

function meta::external::language::haskell::transformation::fromPure::seedTypes(types:Type[*],primTypes:Map[1]):Map[1]
{
  $primTypes->putAll($types->map(t | pair($t, ^NamedTypeRef(name=$t.name->toOne()))))
}

function meta::external::language::haskell::transformation::fromPure::transformPureTypesToHaskell(types:Type[*], typesMap:Map[1], deriving:Deriving[*]):ModuleElement[*]
{
  $types->map(t | $t->pureTypeToHaskell($typesMap,$deriving));
}

function meta::external::language::haskell::transformation::fromPure::pureTypeToHaskell(t:Type[1], typesMap:Map[1], deriving:Deriving[*]):ModuleElement[1]
{
  $t->match([
    c:Class[1] | $c->classToDataType($typesMap,$deriving),
    e:Enumeration[1] | $e->enumerationToDataType($deriving)
  ]);
}

function meta::external::language::haskell::transformation::fromPure::classToDataType(c:Class[1], typesMap:Map[1], deriving:Deriving[*]):meta::external::language::haskell::metamodel::DataType[1]
{
  ^meta::external::language::haskell::metamodel::DataType(
    documentation=$c->documentation(),
    name=$c.name->toOne(),
    constructors=^RecordTypeConstructor(name=$c.name->toOne(),
                                        fields=$c->allProperties()->map( p |  let type = $typesMap->get($p.genericType.rawType->toOne());
                                                                              assert( !$type->isEmpty(), | 'Failed to map type:' + $p.genericType.rawType.name->toOne());
                                                                              let typeWithMul = if(!$p.multiplicity->hasUpperBound() || ($p.multiplicity.upperBound->toOne().value > 1),
                                                                                                   | ^ListType(type=$type->toOne()),
                                                                                                   | $type->toOne());
                                                                              let typeWithMulOpt = if($p.multiplicity.lowerBound.value == 0, | [^NamedTypeRef(name='Optional'), $typeWithMul], | $typeWithMul);                     
                                                                              ^Field(name=$p.name->toOne(),
                                                                                     documentation=$p->documentation(),
                                                                                     type=$typeWithMulOpt);
                                        )
    ),
    deriving=$deriving
  );
}

function meta::external::language::haskell::transformation::fromPure::enumerationToDataType(e:Enumeration[1], deriving:Deriving[*]):meta::external::language::haskell::metamodel::DataType[1]
{
  ^meta::external::language::haskell::metamodel::DataType(
    documentation=$e->documentation(),
    name=$e->enumName(),
    constructors=$e->enumValues()->map( v | ^NamedConstructor(name=$v->toString(),
                                                              documentation=$v->cast(@meta::pure::metamodel::extension::AnnotatedElement)->documentation())),
    deriving=$deriving                                                          
  );
}

function meta::external::language::haskell::transformation::fromPure::documentation(a:meta::pure::metamodel::extension::AnnotatedElement[1]):String[0..1]
{
  let d = $a->meta::pure::functions::doc::getDocs();
  if($d->size() > 1, | $d->joinStrings('\n'), | $d->first());
}