diff options
Diffstat (limited to 'style-generator/src/MyElm')
-rw-r--r-- | style-generator/src/MyElm/Advanced.elm | 46 | ||||
-rw-r--r-- | style-generator/src/MyElm/Stringify.elm | 282 | ||||
-rw-r--r-- | style-generator/src/MyElm/Syntax.elm | 678 | ||||
-rw-r--r-- | style-generator/src/MyElm/Types.elm | 56 |
4 files changed, 1062 insertions, 0 deletions
diff --git a/style-generator/src/MyElm/Advanced.elm b/style-generator/src/MyElm/Advanced.elm new file mode 100644 index 0000000..7f88ab2 --- /dev/null +++ b/style-generator/src/MyElm/Advanced.elm @@ -0,0 +1,46 @@ +module MyElm.Advanced exposing (aliasedName, exposedName, cheat) + +{-| This module allows you to mess with some of the the little things at the cost of a more verbose API. + +@docs aliasedName, exposedName, cheat + +-} + +import MyElm.Types exposing (Expression(..), Ident(..), QualifiedName(..)) + + +{-| Specify a name using a module Alias. If it is a constructor, you must specify the type name as well. +-} +aliasedName : + { modulePath : List String + , aliasName : String + , name : String + , typeName : Maybe String + } + -> QualifiedName +aliasedName opts = + case opts.typeName of + Just tpn -> + Aliased opts.modulePath opts.aliasName (Constructor tpn opts.name) + + Nothing -> + Aliased opts.modulePath opts.aliasName (ValueOrType opts.name) + + +{-| Import a name and expose it. +-} +exposedName : List String -> String -> QualifiedName +exposedName modulePath name = + Bare modulePath (ValueOrType name) + + +{-| Sometimes it is easier to just include a string of Elm code rather than build it up. + +This function will allow you to do that. However, using this breaks the guarantee that the +generated Elm code will be valid. You should be careful to take into consideration things like +brackets in the context where you will use this expression. + +-} +cheat : String -> Expression +cheat = + Literal diff --git a/style-generator/src/MyElm/Stringify.elm b/style-generator/src/MyElm/Stringify.elm new file mode 100644 index 0000000..da2793c --- /dev/null +++ b/style-generator/src/MyElm/Stringify.elm @@ -0,0 +1,282 @@ +module MyElm.Stringify exposing (arg2string, declaration2string, expose2string, expression2string, module2string, needsBrackets, qualifiedName2string, type2str, type2string) + +import MyElm.Types exposing (..) + + + +-- indentation + + +indented : String -> String +indented s = + s + |> String.split "\n" + |> String.join "\n " + |> String.append " " + + +listLike : String -> String -> String -> List String -> String +listLike before sep after l = + let + shouldBeMultiline = + List.any (\ln -> List.length (String.split "\n" ln) > 1) l || List.foldl (\ln s -> s + String.length ln) 0 l > 100 + in + if shouldBeMultiline then + "\n" ++ indented (before ++ " " ++ String.join ("\n" ++ sep) l ++ "\n" ++ after) + + else if after == "" && before == "" then + String.join sep l + + else + before ++ " " ++ String.join sep l ++ " " ++ after + + +bodyIndent : String -> String +bodyIndent str = + if List.length (String.split "\n" str) > 1 then + str + + else + "\n " ++ str + + +expose2string : Exposing -> String +expose2string expose = + case expose of + ValueExposed val -> + val + + TypeExposed tp -> + tp + + TypeAndConstructors tp -> + tp ++ "(..)" + + +module2string : Module -> String +module2string (Module { name, exposes, doc, imports, declarations }) = + let + header = + "module " ++ name ++ " exposing (" ++ String.join ", " (List.map expose2string exposes) ++ ")\n\n" + + docstr = + case doc of + Just d -> + "{-|" ++ d ++ "-}\n\n" + + Nothing -> + "" + + imps = + String.join "\n" imports + ++ (if List.length imports > 0 then + "\n\n\n" + + else + "" + ) + + decs = + String.join "" <| List.map declaration2string declarations + in + header ++ docstr ++ imps ++ decs + + +type2str : Bool -> Type -> String +type2str needsBr tp = + case tp of + NamedType qualifiedName typeList -> + if List.length typeList > 0 then + if needsBr then + "(" ++ qualifiedName2string qualifiedName ++ " " ++ String.join " " (List.map (type2str True) typeList) ++ ")" + + else + qualifiedName2string qualifiedName ++ " " ++ String.join " " (List.map (type2str True) typeList) + + else + qualifiedName2string qualifiedName + + RecordType branches -> + "{ " ++ String.join ", " (List.map (\( name, typ ) -> name ++ " = " ++ type2str False typ) branches) ++ " }" + + FunctionType typeList -> + let + a = + String.join " -> " (List.map (type2str False) typeList) + in + if needsBr then + "(" ++ a ++ ")" + + else + a + + TupleType typeList -> + "( " ++ String.join ", " (List.map (type2str False) typeList) ++ " )" + + TypeVariable name -> + name + + +type2string = + type2str False + + +declaration2string : Declaration -> String +declaration2string declaration = + case declaration of + CustomType name variables variants -> + "type " ++ String.join " " (name :: variables) ++ "\n = " ++ String.join "\n | " (List.map (\( nm, args ) -> String.join " " (nm :: List.map (type2str True) args)) variants) ++ "\n\n\n" + + TypeAlias name variables aliased -> + "type alias " ++ String.join " " (name :: variables) ++ "\n =" ++ type2string aliased ++ "\n\n\n" + + Comment str -> + "{-|" ++ str ++ "}" + + ValueDeclaration name anno argList expression -> + let + decl = + name ++ " " ++ String.join " " (List.map arg2string argList) ++ " =" ++ bodyIndent (expression2string expression) ++ "\n\n\n" + in + case anno of + [] -> + decl + + signature -> + name ++ " : " ++ String.join " -> " (List.map type2string signature) ++ "\n" ++ decl + + +arg2string : Argument -> String +arg2string argument = + case argument of + Argument a -> + a + + +qualifiedName2string : QualifiedName -> String +qualifiedName2string qualifiedName = + let + identifierToStr id = + case id of + Constructor _ s -> + s + + ValueOrType s -> + s + in + case qualifiedName of + Local ident -> + identifierToStr ident + + FullyQualified modPath ident -> + String.join "." modPath ++ "." ++ identifierToStr ident + + Aliased _ alias_ ident -> + alias_ ++ "." ++ identifierToStr ident + + Bare _ ident -> + identifierToStr ident + + +bracketify : Expression -> String +bracketify arg = + if needsBrackets arg then + "(" ++ expression2string arg ++ ")" + + else + expression2string arg + + +isOperator : String -> Bool +isOperator op = + case op of + "++" -> + True + + "-" -> + True + + "+" -> + True + + "*" -> + True + + "/" -> + True + + "//" -> + True + + "^" -> + True + + "|>" -> + True + + "<|" -> + True + + _ -> + False + + +expression2string : Expression -> String +expression2string expression = + case expression of + Call name args -> + let + nameStr = + qualifiedName2string name + in + if isOperator nameStr then + case args of + a :: b :: rest -> + case nameStr of + "|>" -> + listLike "" " |> " "" [ expression2string a, String.join " " (List.map expression2string (b :: rest)) ] + + _ -> + expression2string a ++ " " ++ nameStr ++ " " ++ String.join " " (List.map expression2string (b :: rest)) + + _ -> + "(" ++ nameStr ++ ") " ++ String.join " " (List.map bracketify args) + + else + String.join " " + (nameStr + :: List.map + (\arg -> + if needsBrackets arg then + "(" ++ expression2string arg ++ ")" + + else + expression2string arg + ) + args + ) + + Literal lit -> + lit + + ListExpr expressions -> + listLike "[" ", " "]" (List.map expression2string expressions) + + Tuple expressions -> + listLike "(" ", " ")" (List.map expression2string expressions) + + Record branches -> + listLike "{" ", " "}" (List.map (\( name, branch ) -> name ++ " = " ++ expression2string branch) branches) + + +needsBrackets : Expression -> Bool +needsBrackets expression = + case expression of + Call _ [] -> + False + + Call _ _ -> + True + + _ -> + False diff --git a/style-generator/src/MyElm/Syntax.elm b/style-generator/src/MyElm/Syntax.elm new file mode 100644 index 0000000..7b99915 --- /dev/null +++ b/style-generator/src/MyElm/Syntax.elm @@ -0,0 +1,678 @@ +module MyElm.Syntax exposing + ( QualifiedName, local, valueName, typeName, constructorName + , Expression, string, float, int, list, pair, triple, call0, call1, call2, call3, call4, calln, pipe, record + , Type, type0, type1, type2, typen, recordType, functionType, pairType, tripleType, typeVar + , Declaration, variable, fun1, customType, typeAlias + , build, Exposing, opaque, withConstructors, exposeFn + ) + +{-| This module is intended for autogenerating elm code with +relatively minimal fuss and without needing to do bookkeeping +about minor details like indentation, etc. + +This is meant as the simple, convenient module that you +should get started with. It attempts to reduce boilerplate +to a minimum, but makes some opinionated choice about what +the results should look like. You can also use the Advanced +module if you want to make different choices. + +The simplifcations made here are: + + - Helpers for naming things assume a particular import style. + - Imports are generated for you automatically. + - Custom types and type alaises generate their type variables implicitely. + + +### Naming things + +@docs QualifiedName, local, valueName, typeName, constructorName + + +### Expressions + +@docs Expression, string, float, int, list, pair, triple, call0, call1, call2, call3, call4, calln, pipe, record + + +### Type signatures + +@docs Type, type0, type1, type2, typen, recordType, functionType, pairType, tripleType, typeVar + + +### Declarations + +@docs Declaration, variable, fun1, customType, typeAlias + + +### Modules + +@docs build, Exposing, opaque, withConstructors, exposeFn + +-} + +import MyElm.Stringify +import MyElm.Types exposing (..) +import Set + + +{-| The simplest thing you will need to do is keep track of what things in the program are called and where they come from. +-} +type alias QualifiedName = + MyElm.Types.QualifiedName + + +{-| This is a value (i.e. variable or function, but not type or constructor) from a module whose path is the first argument. +-} +valueName : List String -> String -> QualifiedName +valueName modulePath name = + FullyQualified modulePath (ValueOrType name) + + +{-| This is a type from a module whose path is the first argument. +-} +typeName : List String -> String -> QualifiedName +typeName modulePath name = + Bare modulePath (ValueOrType name) + + +{-| This is a constructor for a type (the second argument) from a module whose path is the first argument. + + just = + constructorName [ "Result" ] "Result" "Just" + +-} +constructorName : List String -> String -> String -> QualifiedName +constructorName modulePath typeNm name = + Bare modulePath (Constructor typeNm name) + + +{-| This is a variable local to the module you are generating. +-} +local : String -> QualifiedName +local name = + Local (ValueOrType name) + + +isLocal : QualifiedName -> Bool +isLocal qualifiedName = + case qualifiedName of + Local _ -> + True + + _ -> + False + + +{-| Create a module and return it as a pretty printed string. +-} +build : + { name : List String + , exposes : List Exposing + , doc : Maybe String + , declarations : List Declaration + } + -> String +build m = + Module + { name = String.join "." m.name + , exposes = m.exposes + , doc = m.doc + , imports = consolidateImports (extractImports m.declarations) + , declarations = m.declarations + } + |> MyElm.Stringify.module2string + + +{-| What you would like to expose from a module. +-} +type alias Exposing = + MyElm.Types.Exposing + + +{-| Expose a custom type, but leave the constructors hidden. +-} +opaque : String -> Exposing +opaque = + TypeExposed + + +{-| Expose a custom type and all its constructors. +-} +withConstructors : String -> Exposing +withConstructors = + TypeAndConstructors + + +{-| Expose a function or value. +-} +exposeFn : String -> Exposing +exposeFn = + ValueExposed + + +{-| -} +type alias Declaration = + MyElm.Types.Declaration + + +{-| This will do automatic type variable extraction for you in order of appearance in the type declaration. + +So for example: + + customType "Foo" + [ ( "Bar", TypeVariable "g" ) + , ( "Baz", TypeVariable "comparable" ) + ] + +would generate the following code: + + type Foo g comparable + = Bar g + | Baz comparable + +If you would like to control the order in which type variables appear, you can use the function in the "Advanced" module. + +-} +customType : String -> List ( String, List Type ) -> Declaration +customType name variants = + CustomType name (List.concatMap (Tuple.second >> List.concatMap extractVariables) variants |> unique) variants + + +{-| Declare a type alias. Also does automatic type variable extraction. +-} +typeAlias : String -> Type -> Declaration +typeAlias name type_ = + TypeAlias name (extractVariables type_ |> unique) type_ + + +unique : List comparable -> List comparable +unique = + Set.fromList >> Set.toList + + +extractVariables : Type -> List String +extractVariables tp = + case tp of + NamedType _ typeList -> + List.concatMap extractVariables typeList + + RecordType branches -> + List.concatMap (Tuple.second >> extractVariables) branches + + FunctionType typeList -> + List.concatMap extractVariables typeList + + TupleType typeList -> + List.concatMap extractVariables typeList + + TypeVariable variable_ -> + [ variable_ ] + + +{-| Declare a top level variable. +-} +variable : String -> Type -> Expression -> Declaration +variable name typeAnno expression = + ValueDeclaration name [ typeAnno ] [] expression + + +{-| Declare a top level function with a single argument. + + fun1 "identity" (typeVar "a") (typeVar "a") "a" call0 + +would be turned into: + + identity : a -> a + identity a = + a + +-} +fun1 : String -> Type -> Type -> String -> (QualifiedName -> Expression) -> Declaration +fun1 name fromTp toTp arg f = + ValueDeclaration name [ fromTp, toTp ] [ Argument arg ] (f (local arg)) + + +{-| The heart of an elm program are the expressions that implement the computations. +-} +type alias Expression = + MyElm.Types.Expression + + +{-| Reference a variable by name. +-} +call0 : QualifiedName -> Expression +call0 name = + Call name [] + + +{-| Call a function with 1 argument. +-} +call1 : QualifiedName -> Expression -> Expression +call1 name arg = + Call name [ arg ] + + +{-| Call a function with 2 arguments. +-} +call2 : QualifiedName -> Expression -> Expression -> Expression +call2 name arg1 arg2 = + Call name [ arg1, arg2 ] + + +{-| Call a function with 3 arguments. +-} +call3 : QualifiedName -> Expression -> Expression -> Expression -> Expression +call3 name arg1 arg2 arg3 = + Call name [ arg1, arg2, arg3 ] + + +{-| Call a function with 4 arguments. +-} +call4 : QualifiedName -> Expression -> Expression -> Expression -> Expression -> Expression +call4 name arg1 arg2 arg3 arg4 = + Call name [ arg1, arg2, arg3, arg4 ] + + +{-| Call a function with any number of arguments. +-} +calln : QualifiedName -> List Expression -> Expression +calln name args = + Call name args + + +{-| A convenience helper for construcing pipelines. + + string "foo" + |> pipe (valueName [ "String" ] "concat") [ string "bar" ] + +would generate: + + "foo" + |> String.concat "bar" + +This is just a helper for: + + pipe name args subject = + call2 (valueName [ "Basics" ] "|>") subject (calln name args) + +-} +pipe : QualifiedName -> List Expression -> Expression -> Expression +pipe name args subject = + Call (valueName [ "Basics" ] "|>") [ subject, Call name args ] + + +{-| A string literal. +-} +string : String -> Expression +string s = + Literal ("\"" ++ String.replace "\"" "\\\"" s ++ "\"") + + +{-| A float literal. +-} +float : Float -> Expression +float f = + Literal (String.fromFloat f) + + +{-| An integer literal. +-} +int : Int -> Expression +int i = + Literal (String.fromInt i) + + +{-| A list literal +-} +list : List Expression -> Expression +list = + ListExpr + + +{-| A two-tuple literal +-} +pair : Expression -> Expression -> Expression +pair a b = + Tuple [ a, b ] + + +{-| A three-tuple literal +-} +triple : Expression -> Expression -> Expression -> Expression +triple a b c = + Tuple [ a, b, c ] + + +{-| A record literal expression. +-} +record : List ( String, Expression ) -> Expression +record = + Record + + +{-| A representation of a type as in a type annotation context. +-} +type alias Type = + MyElm.Types.Type + + +{-| A simple type, like `Int`. +-} +type0 : QualifiedName -> Type +type0 qualifiedName = + NamedType qualifiedName [] + + +{-| A type with one argument, like `List`. +-} +type1 : QualifiedName -> Type -> Type +type1 qualifiedName arg1 = + NamedType qualifiedName [ arg1 ] + + +{-| A type with 2 arguments. +-} +type2 : QualifiedName -> Type -> Type -> Type +type2 qualifiedName arg1 arg2 = + NamedType qualifiedName [ arg1, arg2 ] + + +{-| A type with many arguments. +-} +typen : QualifiedName -> List Type -> Type +typen qualifiedName args = + NamedType qualifiedName args + + +{-| A record type. + +For example we could model + + { foo = Int + , bar = List String + } + +so: + + recordType + [ ( "foo", type0 (typeName [ "Basics" ] "Int") ) + , ( "bar" + , type1 (typeName [ "Basics" ] "List") + (type0 + (typeName [ "String" ] "String") + ) + ) + ] + +-} +recordType : List ( String, Type ) -> Type +recordType = + RecordType + + +{-| A function type. +-} +functionType : List Type -> Type +functionType = + FunctionType + + +{-| Pair type. +-} +pairType : Type -> Type -> Type +pairType a b = + TupleType [ a, b ] + + +{-| -} +tripleType : Type -> Type -> Type -> Type +tripleType a b c = + TupleType [ a, b, c ] + + +{-| A type variable. +-} +typeVar : String -> Type +typeVar = + TypeVariable + + +extractImports : List Declaration -> List QualifiedName +extractImports = + List.concatMap + (\dec -> + case dec of + CustomType _ _ variants -> + List.concatMap (\( _, args ) -> List.concatMap typeImports args) variants + + TypeAlias _ _ aliased -> + typeImports aliased + + Comment _ -> + [] + + ValueDeclaration _ signature _ expression -> + List.concatMap typeImports signature ++ expressionImports expression + ) + + +typeImports : Type -> List QualifiedName +typeImports tp = + case tp of + NamedType qualifiedName args -> + qualifiedName :: List.concatMap typeImports args + + RecordType rec -> + List.concatMap (\( _, typ ) -> typeImports typ) rec + + FunctionType typeList -> + List.concatMap typeImports typeList + + TupleType typeList -> + List.concatMap typeImports typeList + + TypeVariable _ -> + [] + + +expressionImports : Expression -> List QualifiedName +expressionImports expression = + case expression of + Call qualifiedName expressionList -> + qualifiedName :: List.concatMap expressionImports expressionList + + Literal _ -> + [] + + ListExpr expressionList -> + List.concatMap expressionImports expressionList + + Tuple expressionList -> + List.concatMap expressionImports expressionList + + Record branches -> + List.concatMap (Tuple.second >> expressionImports) branches + + +consolidateImports : List QualifiedName -> List String +consolidateImports qualifiedNames = + qualifiedNames + |> List.filter removeDefaults + |> List.map toTupleRep + |> Set.fromList + |> Set.toList + |> List.sort + |> consolidateTuples + |> List.map + (\( mod, al, imps ) -> + let + name = + "import " ++ mod + + alias_ = + if al == "" then + "" + + else + " as " ++ al + + exposingList = + if List.length imps > 0 then + " exposing (" ++ String.join ", " imps ++ ")" + + else + "" + in + String.join "" [ name, alias_, exposingList ] + ) + + +consolidateTuples : List ( String, String, List String ) -> List ( String, String, List String ) +consolidateTuples tuples = + case tuples of + ( xm, xa, xl ) :: ( ym, ya, yl ) :: rest -> + if xm == ym && (xa == ya || xa == "" || ya == "") then + consolidateTuples + (( xm + , if xa == "" then + ya + + else + xa + , xl ++ yl + ) + :: rest + ) + + else + ( xm, xa, xl ) :: consolidateTuples (( ym, ya, yl ) :: rest) + + x -> + x + + +iden2str : Ident -> List String +iden2str ident = + case ident of + Constructor tpname _ -> + [ tpname ++ "(..)" ] + + ValueOrType name -> + [ name ] + + +toTupleRep : QualifiedName -> ( String, String, List String ) +toTupleRep qualifiedName = + case qualifiedName of + Local _ -> + ( "not-possible", "", [] ) + + FullyQualified module_ id -> + ( String.join "." module_, "", [] ) + + Aliased module_ alias_ id -> + ( String.join "." module_, alias_, [] ) + + Bare module_ id -> + ( String.join "." module_, "", iden2str id ) + + +removeDefaults : QualifiedName -> Bool +removeDefaults qualifedName = + case qualifedName of + Local _ -> + False + + FullyQualified module_ id -> + case module_ of + [ "Basics" ] -> + False + + [ "List" ] -> + False + + [ "Maybe" ] -> + False + + [ "Result" ] -> + False + + [ "String" ] -> + False + + [ "Char" ] -> + False + + [ "Tuple" ] -> + False + + [ "Debug" ] -> + False + + [ "Platform" ] -> + False + + _ -> + True + + Aliased module_ alias_ id -> + case ( module_, alias_ ) of + ( [ "Platform", "Cmd" ], "Cmd" ) -> + False + + ( [ "Platform", "Sub" ], "Sub" ) -> + False + + _ -> + True + + Bare module_ (Constructor tpname name) -> + case ( module_, tpname ) of + ( [ "Basics" ], _ ) -> + False + + ( [ "List" ], "List" ) -> + False + + ( [ "Maybe" ], "Maybe" ) -> + False + + ( [ "Result" ], "Result" ) -> + False + + _ -> + True + + Bare module_ (ValueOrType tpname) -> + case ( module_, tpname ) of + ( [ "Basics" ], _ ) -> + False + + ( [ "List" ], "List" ) -> + False + + ( [ "List" ], "::" ) -> + False + + ( [ "Maybe" ], "Maybe" ) -> + False + + ( [ "Result" ], "Result" ) -> + False + + ( [ "String" ], "String" ) -> + False + + ( [ "Char" ], "Char" ) -> + False + + ( [ "Platform" ], "Program" ) -> + False + + ( [ "Platform", "Cmd" ], "Cmd" ) -> + False + + ( [ "Platform", "Sub" ], "Sub" ) -> + False + + _ -> + True diff --git a/style-generator/src/MyElm/Types.elm b/style-generator/src/MyElm/Types.elm new file mode 100644 index 0000000..ef473e4 --- /dev/null +++ b/style-generator/src/MyElm/Types.elm @@ -0,0 +1,56 @@ +module MyElm.Types exposing (Argument(..), Declaration(..), Exposing(..), Expression(..), Ident(..), Module(..), QualifiedName(..), Type(..)) + + +type Module + = Module + { name : String + , exposes : List Exposing + , doc : Maybe String + , imports : List String + , declarations : List Declaration + } + + +type QualifiedName + = Local Ident + | FullyQualified (List String) Ident + | Aliased (List String) String Ident + | Bare (List String) Ident + + +type Ident + = Constructor String String + | ValueOrType String + + +type Exposing + = ValueExposed String + | TypeExposed String + | TypeAndConstructors String + + +type Type + = NamedType QualifiedName (List Type) + | RecordType (List ( String, Type )) + | FunctionType (List Type) + | TupleType (List Type) + | TypeVariable String + + +type Declaration + = CustomType String (List String) (List ( String, List Type )) + | TypeAlias String (List String) Type + | ValueDeclaration String (List Type) (List Argument) Expression + | Comment String + + +type Expression + = Call QualifiedName (List Expression) + | Literal String + | ListExpr (List Expression) + | Tuple (List Expression) + | Record (List ( String, Expression )) + + +type Argument + = Argument String |