Add new project to create a dependency

create-dependency/elm.json

@@ -0,0 +1,31 @@
+{
+    "type": "application",
+    "source-directories": [
+        "src",
+        "../src"
+    ],
+    "elm-version": "0.19.1",
+    "dependencies": {
+        "direct": {
+            "elm/browser": "1.0.2",
+            "elm/core": "1.0.5",
+            "elm/html": "1.0.0",
+            "elm/json": "1.1.3",
+            "elm/project-metadata-utils": "1.0.1",
+            "stil4m/elm-syntax": "7.2.1"
+        },
+        "indirect": {
+            "elm/parser": "1.1.0",
+            "elm/time": "1.0.0",
+            "elm/url": "1.0.0",
+            "elm/virtual-dom": "1.0.2",
+            "elm-community/list-extra": "8.3.0",
+            "rtfeldman/elm-hex": "1.0.0",
+            "stil4m/structured-writer": "1.0.3"
+        }
+    },
+    "test-dependencies": {
+        "direct": {},
+        "indirect": {}
+    }
+}

create-dependency/index.js

@@ -0,0 +1,185 @@
+const util = require('util');
+const https = require('https');
+
+console.warn = () => { }
+
+const Elm = require('./dist');
+
+function get(url) {
+    return new Promise((resolve, reject) => {
+        https.get(url, (resp) => {
+            let data = '';
+            resp.on('data', (chunk) => {
+                data += chunk;
+            });
+            resp.on('end', () => {
+                resolve(data);
+            });
+        }).on("error", reject);
+    })
+}
+
+const packageName = process.argv[2];
+
+if (!packageName) {
+    console.error(`Need to pass in a package name. For instance:
+ 
+        node create-dependency.js elm/html
+`)
+}
+
+async function downloadFiles() {
+    const [elmJson, docsJson] = await Promise.all([
+        get(`https://package.elm-lang.org/packages/${packageName}/latest/elm.json`),
+        get(`https://package.elm-lang.org/packages/${packageName}/latest/docs.json`)
+    ]);
+    return [elmJson, docsJson];
+}
+
+function createFile([elmJson, docsJson]) {
+    const app = Elm.Elm.DependencyCreator.init({
+        flags: { elmJson, docsJson }
+    });
+
+    app.ports.sendToJs.subscribe(result => {
+        console.log(result);
+        process.exit(0);
+    });
+    return;
+
+    const moduleName = packageName
+        .replace("/", "-")
+        .split("-")
+        .map(capitalize)
+        .join("");
+
+    return `module Review.Test.Dependencies.${moduleName} exposing (dependency)
+
+import Elm.Docs
+import Elm.Project
+import Elm.Type
+import Json.Decode as Decode
+import Review.Project.Dependency as Dependency exposing (Dependency)
+
+
+dependency : Dependency
+dependency =
+    Dependency.create
+        "${packageName}"
+        (createElmJsonProject elmJson)
+        dependencyModules
+
+
+createElmJsonProject : String -> Elm.Project.Project
+createElmJsonProject rawElmJson =
+    case Decode.decodeString Elm.Project.decoder rawElmJson of
+        Ok project ->
+            project
+
+        Err error ->
+            Debug.todo ("Failed to decode elm.json for ${packageName}: " ++ Debug.toString error)
+
+
+elmJson : String
+elmJson =
+    """${JSON.stringify(elmJson, null, 4)}
+"""
+
+
+dependencyModules : List Elm.Docs.Module
+dependencyModules =
+    [ ${docsJson.map(formatModule).join("\n    , ")}
+    ]
+
+
+decodeType : String -> Elm.Type.Type
+decodeType type_ =
+    case Decode.decodeString Elm.Type.decoder type_ of
+        Ok resultType ->
+            resultType
+        Err _ ->
+            Elm.Type.Var "unknown"
+`
+}
+
+function capitalize(str) {
+    return str[0].toUpperCase() + str.slice(1);
+}
+
+function formatModule(moduleDoc) {
+    return `{ name = "${moduleDoc.name}"
+      , comment = ${formatComment(moduleDoc.comment)}
+      , unions = [ ${moduleDoc.unions.map(formatUnion).join("\n    , ")} ]
+      , aliases = [ ${moduleDoc.aliases.map(formatAlias).filter(Boolean).join("\n    , ")} ]
+      , values = [ ${moduleDoc.values.map(formatValue).filter(Boolean).join("\n    , ")} ]
+      , binops = [ ${moduleDoc.binops.map(formatBinop).filter(Boolean).join("\n    , ")} ]
+      }`
+    // if (JSON.stringify(moduleDoc).includes("initialize 4")) {
+    //     console.log(JSON.stringify(moduleDoc).slice(2470, 2530))
+    // }
+
+    return JSON.stringify(JSON.stringify(moduleDoc));
+    // .split("\\n")
+    // .join("\\\\n");
+}
+
+function formatUnion(union) {
+    return `{ name = "${union.name}"
+      , comment = ${formatComment(union.comment)}
+      , args = ${JSON.stringify(union.args)}
+      , tags = [ ${union.cases.map(
+        (([name, types]) =>
+            `( "${name}", [ ${types.map(formatType).join(", ")} ] )`)
+    ).join("\n    , ")} ]
+      }`
+}
+
+function formatType(type) {
+    return `decodeType "${type}"`;
+}
+
+function formatComment(comment) {
+    const withEscapedTripleQuotes = comment
+        .split(`"""`).join(`\\"\\"\\"`)
+        .split("\\").join("\\\\");
+    return `"""${withEscapedTripleQuotes}"""`
+}
+
+function formatAlias(alias) {
+    return `{ name = "${alias.name}"
+            , comment = ${formatComment(alias.comment)}
+    , args = ${JSON.stringify(alias.args)}
+    , tipe = ${formatType(alias.type)}
+    }`
+}
+
+function formatValue(value) {
+    return `{ name = "${value.name}"
+    , comment = ${formatComment(value.comment)}
+    , tipe = ${formatType(value.type)}
+    }`
+}
+
+
+function formatBinop(binop) {
+    return `{ name = "${binop.name}"
+    , comment = ${formatComment(binop.comment)}
+    , tipe = ${formatType(binop.type)}
+    , associativity = ${formatAssociativity(binop.associativity)}
+    , precedence = ${binop.precedence}
+    }`
+}
+
+function formatAssociativity(associativity) {
+    switch (associativity) {
+        case "left": return "Elm.Docs.Left"
+        case "right": return "Elm.Docs.Right"
+        case "non": return "Elm.Docs.None"
+        default: return "unknown"
+    }
+}
+
+downloadFiles()
+    .then(createFile)
+    // .then(console.log)
+    .catch(console.error);

create-dependency/src/DependencyCreator.elm

@@ -0,0 +1,164 @@
+port module DependencyCreator exposing (main)
+
+import Elm.Constraint
+import Elm.Docs
+import Elm.License
+import Elm.Module
+import Elm.Package
+import Elm.Project
+import Elm.Type
+import Elm.Version
+import Json.Decode as Decode
+import Review.Project exposing (elmJson)
+import Review.Project.Dependency as Dependency exposing (Dependency)
+
+
+type alias Flags =
+    { elmJson : String
+    , docsJson : String
+    }
+
+
+main : Program Flags () ()
+main =
+    Platform.worker
+        { init = \flags -> ( (), sendToJs (parseThings flags) )
+        , update = \_ _ -> ( (), Cmd.none )
+        , subscriptions = \_ -> Sub.none
+        }
+
+
+parseThings : Flags -> String
+parseThings flags =
+    let
+        elmJson : Result String Elm.Project.PackageInfo
+        elmJson =
+            Decode.decodeString Elm.Project.decoder flags.elmJson
+                |> Result.mapError (\err -> "Problem parsing elm.json: " ++ Debug.toString err)
+                |> Result.andThen
+                    (\elmJson_ ->
+                        case elmJson_ of
+                            Elm.Project.Application _ ->
+                                Err "elm.json is for an application, not a project."
+
+                            Elm.Project.Package package ->
+                                Ok package
+                    )
+
+        docsJson : Result String (List Elm.Docs.Module)
+        docsJson =
+            Decode.decodeString (Decode.list Elm.Docs.decoder) flags.docsJson
+                |> Result.mapError (\err -> "Problem parsing docs.json: " ++ Debug.toString err)
+    in
+    case Result.map2 formatFile elmJson docsJson of
+        Ok str ->
+            str
+
+        Err error ->
+            error
+
+
+formatFile : Elm.Project.PackageInfo -> List Elm.Docs.Module -> String
+formatFile elmJson docsJson =
+    let
+        listOfModuleNames list =
+            list
+                |> List.map (\name -> "unsafeModuleName \"" ++ Elm.Module.toString name ++ "\"")
+                |> String.join ", "
+
+        exposed =
+            case elmJson.exposed of
+                Elm.Project.ExposedList list ->
+                    "Elm.Project.ExposedList [ " ++ listOfModuleNames list ++ " ]"
+
+                Elm.Project.ExposedDict dict ->
+                    "Elm.Project.ExposedDict [ " ++ String.join ", " (List.map (\( section, list ) -> "( \"" ++ section ++ "\", " ++ listOfModuleNames list ++ " ) ") dict) ++ " ]"
+
+        moduleName =
+            "Hello"
+    in
+    "module " ++ moduleName ++ """ exposing (dependency)
+
+import Elm.Constraint
+import Elm.Docs
+import Elm.License
+import Elm.Module
+import Elm.Package
+import Elm.Project
+import Elm.Type
+import Elm.Version
+import Json.Decode as Decode
+import Review.Project.Dependency as Dependency exposing (Dependency)
+
+dependency : Dependency
+dependency =
+    Dependency.create \"""" ++ Elm.Package.toString elmJson.name ++ """"
+        elmJson
+        dependencyModules
+
+
+elmJson : Elm.Project.Project
+elmJson =
+    Elm.Project.Package
+        { deps = [ """ ++ String.join ", " (List.map (\( name, constraint ) -> "( unsafePackageName \"" ++ Elm.Package.toString name ++ "\", unsafeConstraint \"" ++ Elm.Constraint.toString constraint ++ "\" )") elmJson.deps) ++ """ ]
+        , elm = unsafeConstraint \"""" ++ Elm.Constraint.toString elmJson.elm ++ """"
+        , exposed = """ ++ exposed ++ """
+        , license = Elm.License.fromString \"""" ++ Elm.License.toString elmJson.license ++ """" |> Maybe.withDefault Elm.License.bsd3
+        , name = unsafePackageName \"""" ++ Elm.Package.toString elmJson.name ++ """"
+        , summary = \"""" ++ elmJson.summary ++ """"
+        , testDeps = []
+        , version = Elm.Version.fromString \"""" ++ Elm.Version.toString elmJson.version ++ """" |> Maybe.withDefault Elm.Version.one
+        }
+
+
+dependencyModules =
+    {- """ ++ Debug.toString docsJson ++ """ -}
+    []
+
+
+unsafePackageName : String -> Elm.Package.Name
+unsafePackageName packageName =
+    case Elm.Package.fromString packageName of
+        Just name ->
+            name
+
+        Nothing ->
+            -- unsafe, but if the generation went well, it should all be good.
+            unsafePackageName packageName
+                -- Disables the tail-call optimization, so that the test crashes if we enter this case
+                |> identity
+
+
+unsafeModuleName : String -> Elm.Module.Name
+unsafeModuleName moduleName =
+    case Elm.Module.fromString moduleName of
+        Just name ->
+            name
+
+        Nothing ->
+            -- unsafe, but if the generation went well, it should all be good.
+            unsafeModuleName moduleName
+                -- Disables the tail-call optimization, so that the test crashes if we enter this case
+                |> identity
+
+
+unsafeConstraint : String -> Elm.Constraint.Constraint
+unsafeConstraint constraint =
+    case Elm.Constraint.fromString constraint of
+        Just constr ->
+            constr
+
+        Nothing ->
+            -- unsafe, but if the generation went well, it should all be good.
+            unsafeConstraint constraint
+                -- Disables the tail-call optimization, so that the test crashes if we enter this case
+                |> identity
+"""
+
+
+formatPackageName : Elm.Package.Name -> String
+formatPackageName packageName =
+    "Elm.Package.fromString \"" ++ Elm.Package.toString packageName ++ "\" |> Maybe.withDefault Elm.Package.one"
+
+
+port sendToJs : String -> Cmd msg