New Main module

Original commit 67eb907d6a6890bf4f0263564a4b53d1a917ee5a

cli/src/Main.d.ts

@@ -1,18 +1,26 @@
-interface JsonArrayMap {
-    [key: string]: object[];
-  }
-
 interface Renderer {
     name: string;
     extension: string;
     aceMode: string;
 }
 
-type Pipeline = ({ input: JsonArrayMap, renderer: Renderer }) => Either<string, string>;
+type SourceCode = string;
+type ErrorMessage = string;
 
 interface Main {
     renderers: Renderer[];
-    renderFromJsonArrayMap: Pipeline;
-    renderFromJsonSchemaArrayMap: Pipeline;
-    urlsFromJsonGrammar(json: object): Either<string, JsonArrayMap>;
+    main(config: Config): Either<ErrorMessage, SourceCode>;
+    urlsFromJsonGrammar(json: object): Either<string, { [key: string]: string[] }>;
+}
+
+type Json = object;
+
+type TopLevelConfig = 
+       { name: string; sample: Json; }
+     | { name: string; samples: Json[]; }
+     | { name: string; schema: Json; };
+
+interface Config {
+    language: string;
+    topLevels: TopLevelConfig[];     
 }

cli/src/quicktype.ts

@@ -116,6 +116,10 @@ export interface Options {
   help?: boolean;
 }
 
+interface SampleOrSchemaMap {
+  [key: string]: object[];
+}
+
 class Run {
   options: Options;
 
@@ -136,23 +140,22 @@ class Run {
     return renderer;
   }
 
-  renderFromJsonArrayMap = (jsonArrayMap: JsonArrayMap): string => {
-    let pipeline = {
-      "json": Main.renderFromJsonArrayMap,
-      "schema": Main.renderFromJsonSchemaArrayMap
-    }[this.options.srcLang] as Pipeline;
+  renderSamplesOrSchemas = (samplesOrSchemas: SampleOrSchemaMap): SourceCode => {
+    let areSchemas = this.options.srcLang === "schema";
 
-    if (!pipeline) {
-      console.error(`Input language '${this.options.srcLang}' is not supported.`);
-      process.exit(1);
-    }
-
-    let input = {
-      input: jsonArrayMap,
-      renderer: this.getRenderer()
+    let config: Config = {
+      language: this.getRenderer().extension,
+      topLevels: Object.getOwnPropertyNames(samplesOrSchemas).map(name => {
+        if (areSchemas) {
+          // Only one schema per top-level is used right now
+          return { name, schema: samplesOrSchemas[name][0] };
+        } else {
+          return { name, samples: samplesOrSchemas[name]  };
+        }
+      })
     };
-    
-    return Either.fromRight(pipeline(input));    
+
+    return Either.fromRight(Main.main(config));    
   }
 
   splitAndWriteJava = (dir: string, str: string) => {
@@ -186,8 +189,8 @@ class Run {
     writeFile();
   }
 
-  renderAndOutput = (jsonArrayMap: JsonArrayMap) => {
-    let output = this.renderFromJsonArrayMap(jsonArrayMap);
+  renderAndOutput = (samplesOrSchemas: SampleOrSchemaMap) => {
+    let output = this.renderSamplesOrSchemas(samplesOrSchemas);
     if (this.options.out) {
       if (this.options.lang == "java") {
         this.splitAndWriteJava(path.dirname(this.options.out), output);
@@ -200,7 +203,7 @@ class Run {
   }
 
   workFromJsonArray = (jsonArray: object[]) => {
-    let map = <JsonArrayMap>{};
+    let map = <SampleOrSchemaMap>{};
     map[this.options.topLevel] = jsonArray;
     this.renderAndOutput(map);
   }

quicktype.json

@@ -0,0 +1,18 @@
+{
+    "outFile": "quicktype.js",
+    "language": "typescript",
+    "topLevels": [
+        {
+            "name": "User",
+            "sample": "user.json"
+        },
+        {
+            "name": "Person",
+            "sample": "{ \"name\": \"David\" }"
+        },
+        {
+            "name": "Repos",
+            "sample": "https://api.github.com/users/dvdsgl/repos"
+        }
+    ]
+}

src/Config.purs

@@ -0,0 +1,112 @@
+module Config
+    ( parseConfig
+    , Config(..)
+    , TypeSource(..)
+    , TopLevelConfig(..)
+    , topLevelSamples
+    , topLevelSchemas
+    , renderer
+    ) where
+
+import Prelude
+
+import Data.Argonaut.Decode
+import Data.Argonaut.Core (JObject, Json)
+
+import Data.Array as A
+import Data.Either (Either(Right, Left))
+import Data.Foldable (elem, find)
+import Data.Map (Map)
+import Data.Map as Map
+import Data.Maybe (Maybe(Just), fromMaybe, maybe)
+import Data.Tuple (Tuple(..))
+import Doc (Renderer)
+import Doc as Doc
+import Language.JsonSchema (JSONSchema)
+import Language.Renderers as Renderers
+
+data TypeSource
+    = Literal Json
+
+data TopLevelConfig = TopLevelConfig
+    { name :: String
+    , samples :: Array TypeSource
+    , schema :: Maybe JSONSchema
+    }
+
+newtype Config = Config
+    { topLevels :: Array TopLevelConfig
+    , language :: String
+    }
+
+instance decodeTypeSource :: DecodeJson TypeSource where
+    decodeJson j = pure $ Literal j
+
+instance decodeTopLevelConfig :: DecodeJson TopLevelConfig where
+    decodeJson j = do
+        obj <- decodeJson j
+        name <- obj .? "name"
+
+        sample <- obj .?? "sample"
+        samples <- obj .?? "samples"
+
+        let samples' = maybe samples (\s -> Just [s]) sample
+
+        schema <- obj .?? "schema"
+        pure $ TopLevelConfig
+            { name
+            , samples: fromMaybe [] samples'
+            , schema
+            }
+
+instance decodeConfig :: DecodeJson Config where
+    decodeJson j = do
+        obj <- decodeJson j
+        topLevels <- obj .? "topLevels"
+        language <- obj .? "language"
+        pure $ Config
+            { topLevels
+            -- TODO derive from outFile
+            , language
+            }
+
+parseConfig :: Json -> Either String Config
+parseConfig = decodeJson
+
+renderer :: Config -> Either String Doc.Renderer
+renderer (Config { language }) =
+    maybe
+    (Left $ language <> " not supported")
+    Right
+    (find match Renderers.all)
+    where
+        match :: Renderer -> Boolean
+        match ({ aceMode, name, extension }) = elem language [aceMode, name, extension]
+
+topLevelsMap :: Config -> Map String TopLevelConfig
+topLevelsMap (Config { topLevels }) =
+    topLevels
+    <#> (\top@(TopLevelConfig { name }) -> Tuple name top)
+    # Map.fromFoldable
+
+topLevelSamples :: Config -> Map String (Array Json)
+topLevelSamples config = loadTypeSources <$> topLevelsMap config
+
+loadTypeSources :: TopLevelConfig -> Array Json
+loadTypeSources (TopLevelConfig config) = do
+    sample <- config.samples
+    loadTypeSource sample
+
+loadTypeSource :: TypeSource -> Array Json
+loadTypeSource (Literal obj) = [obj]
+
+topLevelSchemas :: Config -> Map String JSONSchema
+topLevelSchemas (Config config) = withSchemas
+    where
+      withSchemas =
+        config.topLevels
+        <#> getNameAndSchema
+        # A.catMaybes
+        # Map.fromFoldable
+
+      getNameAndSchema (TopLevelConfig { name, schema }) = Tuple name <$> schema

src/Core.purs

@@ -0,0 +1,10 @@
+module Core
+    ( module Prelude
+    , Error, SourceCode, Name
+    ) where
+
+import Prelude
+
+type Error = String
+type SourceCode = String
+type Name = String

src/Language/JsonSchema.purs

@@ -1,9 +1,9 @@
 module Language.JsonSchema where
 
+import Core
+
 import Doc
 import IRGraph
-import Prelude
-
 import Control.Monad.Error.Class (throwError)
 
 import Data.Argonaut.Core (Json, foldJson, fromArray, fromBoolean, fromObject, fromString, isBoolean, stringifyWithSpace)
@@ -62,7 +62,7 @@ newtype JSONSchema = JSONSchema
     , title :: Maybe String
     }
 
-decodeEnum :: forall a. StrMap a -> Json -> Either String a
+decodeEnum :: forall a. StrMap a -> Json -> Either Error a
 decodeEnum sm j = do
     key <- decodeJson j
     maybe (Left "Unexpected enum key") Right $ SM.lookup key sm
@@ -77,7 +77,7 @@ instance decodeJsonSchemaRef :: DecodeJson JSONSchemaRef where
             Just nel -> pure $ JSONSchemaRef nel
             Nothing -> Left "ERROR: String.split should return at least one element."
 
-decodeTypes :: Json -> Either String (Either JSONType (Set JSONType))
+decodeTypes :: Json -> Either Error (Either JSONType (Set JSONType))
 decodeTypes j =
     foldJson
         (\_ -> Left "`types` cannot be null")
@@ -92,7 +92,7 @@ decodeTypes j =
         (\_ -> Left "`Types` cannot be an object")
         j
 
-decodeAdditionalProperties :: Maybe Json -> Either String (Either Boolean JSONSchema)
+decodeAdditionalProperties :: Maybe Json -> Either Error (Either Boolean JSONSchema)
 decodeAdditionalProperties Nothing = Right $ Left true
 decodeAdditionalProperties (Just j)
     | isBoolean j = do
@@ -120,7 +120,7 @@ instance decodeJsonSchema :: DecodeJson JSONSchema where
         title <- obj .?? "title"
         pure $ JSONSchema { definitions, ref, types, oneOf, properties, additionalProperties, items, required, title }
 
-lookupRef :: JSONSchema -> List String -> JSONSchema -> Either String JSONSchema
+lookupRef :: JSONSchema -> List String -> JSONSchema -> Either Error JSONSchema
 lookupRef root ref local@(JSONSchema { definitions }) =
     case ref of
     L.Nil -> Right local

src/Main.purs

@@ -1,51 +1,69 @@
-module Main
-    ( renderFromJsonArrayMap
-    , renderFromJsonSchemaArrayMap
-    , renderFromJsonStringPossiblyAsSchemaInDevelopment
-    , renderers
-    , urlsFromJsonGrammar
-    ) where
+module Main (main, renderers, urlsFromJsonGrammar) where
+
+import Core
 
 import IR
 import IRGraph
-import Prelude
-import Transformations
+import Transformations as T
 
-import Language.Renderers as Renderers
-import Language.JsonSchema (JSONSchema, jsonSchemaListToIR)
+import Config as Config
 
+import Control.Monad.State (modify)
 import Data.Argonaut.Core (Json)
 import Data.Argonaut.Core (foldJson) as J
 import Data.Argonaut.Decode (decodeJson) as J
-import Data.Argonaut.Parser (jsonParser) as J
-import Data.Array (foldl)
-import Data.Either (Either(..))
-import Data.Foldable (for_)
+
+import Data.Either (Either)
+
 import Data.List as L
+import Data.Map (Map)
 import Data.Map as Map
-import Data.Maybe (Maybe(..))
-import Data.StrMap (StrMap)
+
 import Data.StrMap as SM
 import Data.String.Util (singular)
+import Data.Traversable (traverse)
 import Data.Tuple (Tuple(..))
+
 import Doc as Doc
-import Environment (Environment(..))
-import Environment as Env
+import Language.JsonSchema (JSONSchema, jsonSchemaListToIR)
+import Language.Renderers as Renderers
 import UrlGrammar (GrammarMap(..), generate)
-import Utils (forStrMap_, mapM, mapStrMapM)
-import Control.Monad.Except (except)
+import Utils (forMapM_, mapM)
 
-type Error = String
-type SourceCode = String
+-- json is a Foreign object whose type is defined in /cli/src/Main.d.ts
+main :: Json -> Either Error SourceCode
+main json = do
+    config <- Config.parseConfig json
 
--- A type representing the input to Pipelines
--- This makes pipelines easier to call from JavaScript
-type Input a =
-    { input :: a
-    , renderer :: Doc.Renderer
-    }
+    let samples = Config.topLevelSamples config
+    let schemas = Config.topLevelSchemas config
 
-type Pipeline a = Input a -> Either Error SourceCode
+    renderer <- Config.renderer config
+
+    graph <- normalizeGraphOrder =<< execIR do
+        makeTypesFromSamples samples
+        T.replaceSimilarClasses
+        T.makeMaps
+        modify regatherClassNames
+
+        -- We don't regatherClassNames for schemas
+        makeTypesFromSchemas schemas
+        modify regatherUnionNames
+
+    pure $ Doc.runRenderer renderer graph
+
+makeTypesFromSamples :: Map Name (Array Json) -> IR Unit
+makeTypesFromSamples jsonArrayMap = do
+    forMapM_ jsonArrayMap \name jsonArray -> do
+        topLevelTypes <- traverse (makeTypeFromJson $ Given name) jsonArray
+        topLevel <- unifyMultipleTypes $ L.fromFoldable topLevelTypes
+        addTopLevel name topLevel
+
+makeTypesFromSchemas :: Map Name JSONSchema -> IR Unit
+makeTypesFromSchemas schemaMap = do
+    forMapM_ schemaMap \name schema -> do
+        topLevel <- jsonSchemaListToIR (Given name) [schema]
+        addTopLevel name topLevel
 
 renderers :: Array Doc.Renderer
 renderers = Renderers.all
@@ -70,51 +88,7 @@ makeTypeFromJson name json =
     where
         toProperty (Tuple name json) = Tuple name <$> makeTypeFromJson (Inferred name) json
 
-makeTypeAndUnify :: StrMap (Array Json) -> Either Error IRGraph
-makeTypeAndUnify jsonArrayMap = execIR do
-    forStrMap_ jsonArrayMap \name jsonArray -> do
-        topLevelTypes <- mapM (makeTypeFromJson $ Given name) $ L.fromFoldable jsonArray
-        topLevel <- unifyMultipleTypes topLevelTypes
-        addTopLevel name topLevel
-    replaceSimilarClasses
-    makeMaps
-
-makeTypeFromSchemaArrayMap :: StrMap (Array Json) -> Either Error IRGraph
-makeTypeFromSchemaArrayMap jsonArrayMap = execIR do
-    forStrMap_ jsonArrayMap \name jsonSchemaArray -> do
-        schemaArray <- mapM (except <<< J.decodeJson) jsonSchemaArray
-        topLevel <- jsonSchemaListToIR (Given name) schemaArray
-        addTopLevel name topLevel
-
-renderFromJsonArrayMap :: Pipeline (StrMap (Array Json))
-renderFromJsonArrayMap { renderer, input: jsonArrayMap } = do
-    graph <- makeTypeAndUnify jsonArrayMap
-    normalGraph <- graph # regatherClassNames # regatherUnionNames # normalizeGraphOrder
-    pure $ Doc.runRenderer renderer normalGraph
-    
-renderFromJsonSchemaArrayMap :: Pipeline (StrMap (Array Json))
-renderFromJsonSchemaArrayMap { renderer, input: jsonArrayMap } = do
-    graph <- makeTypeFromSchemaArrayMap jsonArrayMap
-    normalGraph <- normalizeGraphOrder (regatherUnionNames graph)
-    pure $ Doc.runRenderer renderer normalGraph
-
-pipelines :: Environment -> Array (Pipeline (StrMap (Array Json)))
-pipelines Development = [renderFromJsonArrayMap]
-pipelines Production = [renderFromJsonArrayMap]
-
-firstSuccess :: forall a. Array (Pipeline a) -> Pipeline a
-firstSuccess pipes input = foldl takeFirstRight (Left "no pipelines provided") pipes
-    where
-        takeFirstRight (Right output) _ = Right output
-        takeFirstRight _ pipeline = pipeline input
-
-renderFromJsonStringPossiblyAsSchemaInDevelopment :: String -> Pipeline String
-renderFromJsonStringPossiblyAsSchemaInDevelopment  topLevelName { renderer, input: jsonString } = do
-    obj <- J.jsonParser jsonString
-    firstSuccess (pipelines Env.current) { renderer, input: SM.singleton topLevelName [obj] }
-
-urlsFromJsonGrammar :: Json -> Either String (StrMap (Array String))
-urlsFromJsonGrammar json =
-    case J.decodeJson json of
-    Left err -> Left err
-    Right (GrammarMap grammarMap) -> Right $ SM.mapWithKey (const generate) grammarMap
+urlsFromJsonGrammar :: Json -> Either Error (SM.StrMap (Array String))
+urlsFromJsonGrammar json = do
+    GrammarMap grammarMap <- J.decodeJson json
+    pure $ generate <$> grammarMap

src/UrlGrammar.purs

@@ -7,14 +7,16 @@ module UrlGrammar
 import Prelude
 
 import Data.Argonaut.Core (Json, JObject, foldJson, toArray, toObject)
-import Data.Argonaut.Decode (class DecodeJson, decodeJson)
+import Data.Argonaut.Decode (class DecodeJson, decodeJson, (.?))
+import Data.Array (fold)
 import Data.Array as A
 import Data.Either (Either(..))
 import Data.List (List, (:))
 import Data.List as L
+import Data.Map (Map)
+import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.StrMap (StrMap)
-import Data.StrMap as SM
 import Data.Traversable (class Foldable, traverse)
 import Data.Tuple (Tuple(..))
 import Utils (mapM, mapStrMapM)
@@ -43,19 +45,11 @@ generateAll (Choice l) = do
 generate :: Grammar -> Array String
 generate g =
     let all = A.fromFoldable $ generateAll g
-    in
-        map (A.foldl (<>) "") all
+    in map fold all
+
+decodeObject :: JObject -> Either String Grammar
+decodeObject obj = Choice <$> (obj .? "oneOf")
 
-decodeObject :: StrMap Json -> Either String Grammar
-decodeObject obj =
-    case SM.lookup "oneOf" obj of
-    Nothing -> Left "Object must have a 'oneOf' field"
-    Just x ->
-        case toArray x of
-        Nothing -> Left "'oneOf' value must be an array"
-        Just options -> do
-            mapped <- mapM decodeJson options
-            pure $ Choice $ L.fromFoldable mapped
 
 mkSequence :: forall f. Foldable f => f Grammar -> Grammar
 mkSequence = Sequence <<< L.fromFoldable

src/Utils.purs

@@ -9,13 +9,15 @@ module Utils
     , removeElement
     , forEnumerated_
     , forStrMap_
+    , forMapM
+    , forMapM_
     ) where
 
 import Prelude
 
 import Data.Array as A
 import Data.Either (Either(..), either)
-import Data.Foldable (find, foldr)
+import Data.Foldable (find, foldr, traverse_)
 import Data.List (List, (:))
 import Data.List as L
 import Data.Map (Map)
@@ -31,6 +33,14 @@ import Data.Tuple (Tuple(..))
 mapM :: forall m a b t. Applicative m => Traversable t => (a -> m b) -> t a -> m (t b)
 mapM = traverse
 
+forMapM :: forall a v k m. Monad m => Ord k => Map k v -> (k -> v -> m a) -> m (Map k a)
+forMapM = flip mapMapM
+
+forMapM_ :: forall a v k m. Monad m => Ord k => Map k v -> (k -> v -> m a) -> m Unit
+forMapM_ m f = do
+    _ <- forMapM m f
+    pure unit
+
 mapMapM :: forall m k v w. Monad m => Ord k  => (k -> v -> m w) -> Map k v -> m (Map k w)
 mapMapM f m = do
     arr <- mapM mapper (M.toUnfoldable m :: Array _)