Last active
May 11, 2024 09:00
-
-
Save miniBill/3dde3c476ff8b1dea1e19f29e5c2a387 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Elm.Declare.Module exposing (Annotation, Function, Internal, Module, ModuleName, Value, abstractFn, alias, customType, exposeConstructor, exposed, fn, fn2, include, module_, toFile, unexposed, value) | |
import Elm | |
import Elm.Annotation as Annotation | |
import Gen.Debug | |
type alias ModuleName = | |
List String | |
type alias Module x = | |
{ name : ModuleName | |
, declarations : List Elm.Declaration | |
, call : x | |
} | |
type alias Annotation = | |
{ annotation : Annotation.Annotation | |
, declaration : Elm.Declaration | |
, internal : Internal Annotation.Annotation | |
} | |
type alias Function tipe = | |
{ value : Elm.Expression | |
, call : tipe | |
, declaration : Elm.Declaration | |
, internal : Internal tipe | |
} | |
type alias Value = | |
{ value : Elm.Expression | |
, declaration : Elm.Declaration | |
, internal : Internal Elm.Expression | |
} | |
type Internal x | |
= Internal | |
{ call : ModuleName -> x | |
, exposeConstructor : Bool | |
} | |
module_ : x -> ModuleName -> Module x | |
module_ ctor name = | |
{ name = name | |
, call = ctor | |
, declarations = [] | |
} | |
exposed : { a | declaration : Elm.Declaration, internal : Internal x } -> Module (x -> y) -> Module y | |
exposed decl moduleBuilder = | |
let | |
(Internal internal) = | |
decl.internal | |
in | |
{ name = moduleBuilder.name | |
, declarations = | |
(if internal.exposeConstructor then | |
Elm.exposeWith { exposeConstructor = True, group = Nothing } | |
else | |
Elm.expose | |
) | |
decl.declaration | |
:: moduleBuilder.declarations | |
, call = moduleBuilder.call (internal.call moduleBuilder.name) | |
} | |
exposeConstructor : { a | internal : Internal x } -> { a | internal : Internal x } | |
exposeConstructor decl = | |
let | |
(Internal internal) = | |
decl.internal | |
in | |
{ decl | internal = Internal { internal | exposeConstructor = True } } | |
unexposed : { a | declaration : Elm.Declaration } -> Module y -> Module y | |
unexposed decl moduleBuilder = | |
{ moduleBuilder | |
| declarations = decl.declaration :: moduleBuilder.declarations | |
} | |
include : List Elm.Declaration -> Module x -> Module x | |
include declarations moduleBuilder = | |
{ moduleBuilder | |
| declarations = List.reverse declarations ++ moduleBuilder.declarations | |
} | |
alias : | |
String | |
-> Annotation.Annotation | |
-> Annotation | |
alias name annotation = | |
{ annotation = Annotation.named [] name | |
, declaration = Elm.alias name annotation | |
, internal = | |
Internal | |
{ call = \moduleName -> Annotation.named moduleName name | |
, exposeConstructor = False | |
} | |
} | |
customType : | |
String | |
-> List Elm.Variant | |
-> Annotation | |
customType name variants = | |
{ annotation = Annotation.named [] name | |
, declaration = Elm.customType name variants | |
, internal = | |
Internal | |
{ call = \moduleName -> Annotation.named moduleName name | |
, exposeConstructor = False | |
} | |
} | |
abstractFn : | |
String | |
-> ( String, Maybe Annotation.Annotation ) | |
-> Maybe Annotation.Annotation | |
-> Function (Elm.Expression -> Elm.Expression) | |
abstractFn name arg1 resultType = | |
fn name | |
arg1 | |
(\_ -> | |
case resultType of | |
Nothing -> | |
Gen.Debug.todo "abstractFn" | |
Just tipe -> | |
Gen.Debug.todo "abstractFn" | |
|> Elm.withType tipe | |
) | |
fn : | |
String | |
-> ( String, Maybe Annotation.Annotation ) | |
-> (Elm.Expression -> Elm.Expression) | |
-> Function (Elm.Expression -> Elm.Expression) | |
fn name arg1Decl toExpression = | |
{ value = Elm.val name | |
, call = | |
\arg1 -> | |
Elm.apply | |
(Elm.val name) | |
[ arg1 ] | |
, declaration = Elm.declaration name (Elm.fn arg1Decl toExpression) | |
, internal = | |
Internal | |
{ call = | |
\moduleName arg1 -> | |
Elm.apply | |
(Elm.value | |
{ importFrom = moduleName | |
, name = name | |
, annotation = Nothing -- TODO: calculate this. Probably by applying `fn` to `arg1` and checking the resulting type | |
} | |
) | |
[ arg1 ] | |
, exposeConstructor = False | |
} | |
} | |
fn2 : | |
String | |
-> ( String, Maybe Annotation.Annotation ) | |
-> ( String, Maybe Annotation.Annotation ) | |
-> (Elm.Expression -> Elm.Expression -> Elm.Expression) | |
-> Function (Elm.Expression -> Elm.Expression -> Elm.Expression) | |
fn2 name arg1Decl arg2Decl toExpression = | |
{ value = Elm.val name | |
, call = | |
\arg1 arg2 -> | |
Elm.apply | |
(Elm.val name) | |
[ arg1, arg2 ] | |
, declaration = Elm.declaration name (Elm.fn2 arg1Decl arg2Decl toExpression) | |
, internal = | |
Internal | |
{ call = | |
\moduleName arg1 arg2 -> | |
Elm.apply | |
(Elm.value | |
{ importFrom = moduleName | |
, name = name | |
, annotation = Nothing -- TODO: calculate this. Probably by applying `fn` to `arg1` and checking the resulting type | |
} | |
) | |
[ arg1, arg2 ] | |
, exposeConstructor = False | |
} | |
} | |
value : | |
String | |
-> Elm.Expression | |
-> Value | |
value name expression = | |
{ value = Elm.val name | |
, declaration = Elm.declaration name expression | |
, internal = | |
Internal | |
{ call = | |
\moduleName -> | |
Elm.value | |
{ importFrom = moduleName | |
, name = name | |
, annotation = Nothing -- TODO: calculate this | |
} | |
, exposeConstructor = False | |
} | |
} | |
toFile : Module x -> Elm.File | |
toFile moduleBuilder = | |
Elm.file moduleBuilder.name (List.reverse moduleBuilder.declarations) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment