ocaml-export (empty) → 0.1.0.0

raw patch · 24 files changed

+4028/−0 lines, 24 filesdep +QuickCheckdep +aesondep +basesetup-changed

Dependencies added: QuickCheck, aeson, base, bytestring, constraints, containers, directory, file-embed, filepath, formatting, hspec, hspec-golden-aeson, mtl, ocaml-export, process, quickcheck-arbitrary-adt, servant, servant-server, split, template-haskell, text, time, typelits-witnesses, wai, wai-extra, warp, wl-pprint-text

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• ocaml-export.cabal +104/−0
• src/OCaml/BuckleScript/Decode.hs +482/−0
• src/OCaml/BuckleScript/Encode.hs +497/−0
• src/OCaml/BuckleScript/Internal/Module.hs +239/−0
• src/OCaml/BuckleScript/Internal/Package.hs +268/−0
• src/OCaml/BuckleScript/Internal/Spec.hs +245/−0
• src/OCaml/BuckleScript/Record.hs +255/−0
• src/OCaml/BuckleScript/Spec.hs +92/−0
• src/OCaml/BuckleScript/Types.hs +551/−0
• src/OCaml/Export.hs +62/−0
• src/OCaml/File.hs +89/−0
• src/OCaml/Internal/Common.hs +162/−0
• test/Dependency.hs +154/−0
• test/File.hs +86/−0
• test/FileApp.hs +36/−0
• test/Options.hs +69/−0
• test/Product.hs +222/−0
• test/ProductApp.hs +8/−0
• test/Spec.hs +97/−0
• test/Sum.hs +179/−0
• test/SumApp.hs +8/−0
• test/Util.hs +91/−0

@@ -0,0 +1,30 @@+Copyright James M.C. Haver II (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of James M.C. Haver II nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,104 @@+-- This file has been generated from package.yaml by hpack version 0.17.1.+--+-- see: https://github.com/sol/hpack++name:           ocaml-export+version:        0.1.0.0+synopsis:       Convert Haskell types in OCaml types+description:    README.md+category:       Web+homepage:       https://github.com/plow-technologies/ocaml-export#readme+bug-reports:    https://github.com/plow-technologies/ocaml-export/issues+author:         James M.C. Haver II+maintainer:     james.haver@plowtech.net+copyright:      2017 Plow Technologies+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/plow-technologies/ocaml-export++library+  hs-source-dirs:+      src+  ghc-options: -Wall -Wredundant-constraints -fprint-potential-instances+  build-depends:+      base >= 4.7 && < 5+    , aeson+    , bytestring+    , containers+    , directory+    , file-embed+    , filepath+    , formatting+    , hspec-golden-aeson >= 0.4.0.0+    , mtl+    , split+    , QuickCheck+    , quickcheck-arbitrary-adt+    , servant+    , servant-server+    , text+    , template-haskell+    , time+    , typelits-witnesses+    , wl-pprint-text+  exposed-modules:+      OCaml.Export+      OCaml.BuckleScript.Decode+      OCaml.BuckleScript.Encode+      OCaml.BuckleScript.Record+      OCaml.BuckleScript.Spec+      OCaml.BuckleScript.Types+      OCaml.Internal.Common+      OCaml.BuckleScript.Internal.Spec+      OCaml.BuckleScript.Internal.Module+      OCaml.BuckleScript.Internal.Package+  other-modules:+      OCaml.File+      Paths_ocaml_export+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  ghc-options: -fprint-potential-instances+  build-depends:+      base+    , aeson+    , bytestring+    , constraints+    , containers+    , directory+    , filepath+    , hspec+    , hspec-golden-aeson+    , ocaml-export+    , process+    , QuickCheck+    , quickcheck-arbitrary-adt+    , servant+    , servant-server+    , template-haskell+    , text+    , time+    , wai+    , wai-extra+    , warp+    , typelits-witnesses+  other-modules:+      Dependency+      File+      FileApp+      Options+      Product+      ProductApp+      Sum+      SumApp+      Util+  default-language: Haskell2010

@@ -0,0 +1,482 @@+{-|+Module      : OCaml.BuckleScript.Decode+Description : Make a JSON decoder for an OCamlDatatype that matches Generic aeson FromJSON+Copyright   : Plow Technologies, 2017+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : experimental++-}++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module OCaml.BuckleScript.Decode+  ( toOCamlDecoderSourceWith+  , toOCamlDecoderInterfaceWith+  ) where++-- base+import Control.Monad.Reader+import qualified Data.List as L+import Data.Maybe (catMaybes)+import Data.Monoid+import Data.Proxy (Proxy (..))        ++-- aeson+import qualified Data.Aeson.Types as Aeson (Options(..))++-- containers+import qualified Data.Map.Strict as Map++-- text+import Data.Text (Text)+import qualified Data.Text as T++-- wl-pprint+import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>))++-- ocaml-export+import OCaml.BuckleScript.Types hiding (getOCamlValues)+import OCaml.Internal.Common+++-- | Render OCamlDatatype into an OCaml declaration+class HasDecoder a where+  render :: a -> Reader TypeMetaData Doc++-- | Render OCamlPrimitive decoders and type parameters+class HasDecoderRef a where+  renderRef :: a -> Reader TypeMetaData Doc++-- | Render OCamlDataype into an OCaml interface+class HasDecoderInterface a where+  renderInterface :: a -> Reader TypeMetaData Doc++instance HasDecoderInterface OCamlDatatype where+  renderInterface datatype@(OCamlDatatype _ typeName constructor@(OCamlSumOfRecordConstructor _ (MultipleConstructors constructors))) = do+    fnName <- renderRef datatype+    let typeParameterInterfaces = linesBetween $ catMaybes (renderSumRecordInterface typeName . OCamlValueConstructor <$> constructors)+        (typeParameterEncoders, typeParameters) = renderTypeParameterVals constructor+    pure $ typeParameterInterfaces+      <$$> "val" <+> fnName <+> ":" <+> typeParameterEncoders <> "Js_json.t ->" <+> "(" <> typeParameters <> (stext . textLowercaseFirst $ typeName) <> ", string)" <+> "Js_result.t"+    ++  renderInterface datatype@(OCamlDatatype _ typeName constructors) = do+    fnName <- renderRef datatype+    let (typeParameterEncoders, typeParameters) = renderTypeParameterVals constructors+    pure $ "val" <+> fnName <+> ":" <+> typeParameterEncoders <> "Js_json.t ->" <+> "(" <> typeParameters <> (stext . textLowercaseFirst $ typeName) <> ", string)" <+> "Js_result.t"++  renderInterface _ = pure ""+++renderSumRecord :: Text -> OCamlConstructor -> Reader TypeMetaData (Maybe Doc)+renderSumRecord typeName (OCamlValueConstructor (RecordConstructor name value)) = do+  let sumRecordName = typeName <> name+  fnBody <- render (OCamlValueConstructor $ RecordConstructor (typeName <> name) value)+  ocamlInterface <- asks (includeOCamlInterface . userOptions)+  if ocamlInterface+    then+      pure $ Just $ "let decode" <> stext sumRecordName <+> "json =" <$$> fnBody+    else+      pure $ Just $ "let decode" <> stext sumRecordName <+> "(json : Js_json.t)" <+> ":(" <> (stext $ textLowercaseFirst sumRecordName) <> ", string)" <+> "Js_result.t =" <$$> fnBody++renderSumRecord _ _ = return Nothing+++instance HasDecoder OCamlDatatype where+  -- Sum with records+  render datatype@(OCamlDatatype _ typeName constructor@(OCamlSumOfRecordConstructor _ (MultipleConstructors constructors))) = do+    fnName <- renderRef datatype+    fnBody <- mapM renderSum (OCamlSumOfRecordConstructor typeName <$> constructors)+    typeParameterDeclarations <- linesBetween <$> catMaybes <$> sequence (renderSumRecord typeName . OCamlValueConstructor <$> constructors)+    ocamlInterface <- asks (includeOCamlInterface . userOptions)+    if ocamlInterface+      then do+       pure $ typeParameterDeclarations <$$>+         ("let" <+> fnName <+> "json =") <$$>+         (indent 2 ("match Aeson.Decode.(field \"tag\" string json) with" <$$> foldl1 (<$$>) fnBody <$$> fnFooter))+      else do+        let (typeParameterSignatures,typeParameters) = renderTypeParameters constructor+        pure $ typeParameterDeclarations <$$>+          ("let" <+> fnName <+> typeParameterSignatures <+> "(json : Js_json.t)" <+> typeParameters <> ":(" <> stext (textLowercaseFirst typeName) <> ", string) Js_result.t =") <$$>+          (indent 2 ("match Aeson.Decode.(field \"tag\" string json) with" <$$> foldl1 (<$$>) fnBody <$$> fnFooter))+    where+      fnFooter =+              "| err -> Js_result.Error (\"Unknown tag value found '\" ^ err ^ \"'.\")"+         <$$> "| exception Aeson.Decode.DecodeError message -> Js_result.Error message"+++  render datatype@(OCamlDatatype _ name constructor@(OCamlEnumeratorConstructor constructors)) = do+    fnName <- renderRef datatype+    fnBody <- mapM render constructors+    ocamlInterface <- asks (includeOCamlInterface . userOptions)+    if ocamlInterface+      then do+        pure $ "let" <+> fnName <+> "json ="+          <$$> indent 2 ("match Js_json.decodeString json with"+          <$$> foldl1 (<$$>) fnBody <$$> fnFooter fnName)+      else do+        let (typeParameterSignatures,typeParameters) = renderTypeParameters constructor+            returnType =  "(" <> typeParameters <> (stext . textLowercaseFirst $ name) <> ", string) Js_result.t ="+        pure $ "let" <+> fnName <+> typeParameterSignatures <+>"(json : Js_json.t) :" <> returnType+          <$$> indent 2 ("match Js_json.decodeString json with"+          <$$> foldl1 (<$$>) fnBody <$$> fnFooter fnName)+    where+      fnFooter fnName+        =    "| Some err -> Js_result.Error (\"" <> fnName <> ": unknown enumeration '\" ^ err ^ \"'.\")"+        <$$> "| None -> Js_result.Error \"" <> fnName <> ": expected a top-level JSON string.\""+      +  render datatype@(OCamlDatatype _ name constructor) = do+    fnName <- renderRef datatype+    fnBody <- render constructor+    ocamlInterface <- asks (includeOCamlInterface . userOptions)+    if ocamlInterface+      then do+        let typeParameters = getTypeParameters constructor+            renderedTypeParameters = foldl (<>) "" $ stext <$> L.intersperse " " ((\t -> "decode" <> (textUppercaseFirst t)) <$> typeParameters)+        pure $ "let" <+> fnName <+> renderedTypeParameters <+> "json" <+> "=" <$$> fnBody+      else do+        let (typeParameterSignatures,typeParameters) = renderTypeParameters constructor+            returnType = "(" <> typeParameters <> (stext . textLowercaseFirst $ name) <> ", string) Js_result.t ="+        pure $ "let" <+> fnName <+> typeParameterSignatures <+> "(json : Js_json.t) :" <> returnType <$$> fnBody++  render (OCamlPrimitive primitive) = renderRef primitive++instance HasDecoderRef OCamlDatatype where+  -- this should only catch type parameters+  renderRef datatype@(OCamlDatatype typeRef name _) =+    if isTypeParameterRef datatype+    then+      pure $ parens ("fun a -> unwrapResult" <+> parens ("decode" <> (stext . textUppercaseFirst $ name) <+> "a"))+    else do+      mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData +      case mOCamlTypeMetaData of+        Nothing -> pure $ "decode" <> (stext . textUppercaseFirst $ name)+        Just decOCamlTypeMetaData -> do+          ds <- asks (dependencies . userOptions)+          case Map.lookup typeRef ds of+            Just parOCamlTypeMetaData -> do+              let prefix = stext $ mkModulePrefix decOCamlTypeMetaData parOCamlTypeMetaData+              pure $ prefix <> "decode" <> (stext . textUppercaseFirst $ name)++            Nothing -> fail ("OCaml.BuckleScript.Decode (HasDecoderRef OCamlDataType) expected to find dependency:\n\n" ++ show typeRef ++ "\n\nin\n\n" ++ show ds)++  renderRef (OCamlPrimitive primitive) = renderRef primitive++instance HasDecoder OCamlConstructor where+  render (OCamlValueConstructor (NamedConstructor name value)) = do+    decoder <- render value+    return $ indent 2 $ "match Aeson.Decode." <> decoder <+> "json" <+> "with"+        <$$> "| v -> Js_result.Ok" <+> parens (stext name <+> "v")+        <$$> "| exception Aeson.Decode.DecodeError msg -> Js_result.Error (\"decode" <> (stext . textUppercaseFirst $ name) <> ": \" ^ msg)"+           +  render (OCamlValueConstructor (RecordConstructor name value)) = do+    decoders <- render value+    pure+         $ "  match Aeson.Decode."+      <$$> (indent 4 ("{" <+> decoders <$$> "}"))+      <$$> "  with"+      <$$> "  | v -> Js_result.Ok v"+      <$$> "  | exception Aeson.Decode.DecodeError message -> Js_result.Error (\"decode" <> (stext . textUppercaseFirst $ name) <> ": \" ^ message)"++  render (OCamlValueConstructor (MultipleConstructors constructors)) = do+    decoders <- mapM (renderSum . OCamlValueConstructor) constructors+    pure $ indent 2 "match Aeson.Decode.(field \"tag\" string json) with"+      <$$> indent 2 (foldl (<$$>) "" decoders)+      <$$> indent 2 fnFooter+    where+      fnFooter = "| err -> Js_result.Error (\"Unknown tag value found '\" ^ err ^ \"'.\")"+            <$$> "| exception Aeson.Decode.DecodeError message -> Js_result.Error message"++  render _ = pure ""++renderResult :: Text -> OCamlDatatype -> Reader TypeMetaData Doc+renderResult jsonFieldname (OCamlDatatype _ datatypeName _constructor) =+  pure+    $ "(field" <+> dquotes (stext jsonFieldname)+    <+> "(fun a -> unwrapResult (decode" <> (stext . textUppercaseFirst $ datatypeName) <+> "a)))"+renderResult jsonFieldname datatype@(OCamlPrimitive _primitive) = do+  dv <- renderRef datatype+  pure $ "(field" <+> dquotes (stext jsonFieldname) <+> dv <> ")"++instance HasDecoder OCamlValue where+  render ref@(OCamlRef typeRef name) = do+    mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData+    case mOCamlTypeMetaData of+      Nothing -> fail $ "OCaml.BuckleScript.Decode (HasDecoder (OCamlRef typeRep name )) mOCamlTypeMetaData is Nothing:\n\n" ++ (show ref)+      Just decOCamlTypeMetaData -> do+        ds <- asks (dependencies . userOptions)+        case Map.lookup typeRef ds of+          Just parOCamlTypeMetaData -> do+            let prefix = stext $ mkModulePrefix decOCamlTypeMetaData parOCamlTypeMetaData+            pure $ "(fun a -> unwrapResult (" <> prefix  <> "decode" <> (stext . textUppercaseFirst $ name) <+> "a))"             ++          -- in case of a Haskell sum of products, ocaml-export creates a definition for each product+          -- within the same file as the sum. These products will not be in the dependencies map.+          Nothing -> pure $ "(fun a -> unwrapResult (decode" <> (stext . textUppercaseFirst $ name) <+> "a))" ++  render (OCamlPrimitiveRef primitive) = renderRef primitive++  render (OCamlTypeParameterRef name) =+    pure $ "(fun a -> unwrapResult (decode" <> (stext . textUppercaseFirst $ name) <+> "a))"++  render (Values x y) = do+    dx <- render x+    dy <- render y+    return $ dx <$$> ";" <+> dy++  render (OCamlField name (OCamlPrimitiveRef (OOption datatype))) = do+    ao <- asks (aesonOptions . userOptions)+    let jsonFieldname = T.pack . Aeson.fieldLabelModifier ao . T.unpack $ name+    optional <- renderResult jsonFieldname datatype+    return $ (stext name) <+> "=" <+> "optional" <+> optional <+> "json"++  render (OCamlField name value) = do+    ao <- asks (aesonOptions . userOptions)+    let jsonFieldname = T.pack . Aeson.fieldLabelModifier ao . T.unpack $ name    +    dv <- render value+    return $ (stext name) <+> "=" <+> "field" <+> dquotes (stext jsonFieldname) <+> dv <+> "json"++  render OCamlEmpty = pure (stext "")++instance HasDecoder EnumeratorConstructor where+  render (EnumeratorConstructor name) = pure $ "| Some \"" <> stext name <> "\" -> Js_result.Ok" <+> stext name+  +instance HasDecoderRef OCamlPrimitive where+  renderRef OUnit = pure $ parens "()"+  renderRef ODate = pure "date"+  renderRef OInt = pure "int"+  renderRef OBool = pure "bool"+  renderRef OChar = pure "char"+  renderRef OFloat = pure "float"+  renderRef OString = pure "string"++  renderRef (OList (OCamlPrimitive OChar)) = pure "string"++  renderRef (OList datatype@(OCamlDatatype typeRef name _)) =+    if isTypeParameterRef datatype+    then+      pure . parens $ "list" <+> (parens $ "fun a -> unwrapResult (decode" <> (stext . textUppercaseFirst $ name) <+> "a)")+    else do+      mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData+      case mOCamlTypeMetaData of+        Nothing -> fail $ "OCaml.BuckleScript.Decode (HasDecoderRef (OList (OCamlDatatype typeRep name _))) mOCamlTypeMetaData is Nothing:\n\n" ++ (show datatype)+        Just decOCamlTypeMetaData -> do+          ds <- asks (dependencies . userOptions)+          case Map.lookup typeRef ds of+            Just parOCamlTypeMetaData -> do+              let prefix = stext $ mkModulePrefix decOCamlTypeMetaData parOCamlTypeMetaData+              pure . parens $ "list" <+> (parens $ "fun a -> unwrapResult (" <> prefix <> "decode" <> (stext . textUppercaseFirst $ name) <+> "a)")+            Nothing -> fail ("OCaml.BuckleScript.Decode (HasDecoderRef (OList (OCamlDatatype typeRep name _))) expected to find dependency:\n\n" ++ show typeRef ++ "\n\nin\n\n" ++ show ds)++  renderRef (OList datatype) = do+    dt <- renderRef datatype+    pure . parens $ "list" <+> dt++  renderRef (OOption _) = pure ""++  renderRef (OEither v0 v1) = do+    dv0 <- renderRef v0+    dv1 <- renderRef v1+    pure $ parens $ "either" <+> dv0 <+> dv1++  renderRef (OTuple2 v0 v1) = do+    dv0 <- renderRef v0+    dv1 <- renderRef v1+    pure $ parens $ "pair" <+> dv0 <+> dv1++  renderRef (OTuple3 v0 v1 v2) = do+    dv0 <- renderRef v0+    dv1 <- renderRef v1+    dv2 <- renderRef v2+    pure $ parens $ "tuple3" <+> dv0 <+> dv1 <+> dv2++  renderRef (OTuple4 v0 v1 v2 v3) = do+    dv0 <- renderRef v0+    dv1 <- renderRef v1+    dv2 <- renderRef v2+    dv3 <- renderRef v3+    pure $ parens $ "tuple4" <+> dv0 <+> dv1 <+> dv2 <+> dv3++  renderRef (OTuple5 v0 v1 v2 v3 v4) = do+    dv0 <- renderRef v0+    dv1 <- renderRef v1+    dv2 <- renderRef v2+    dv3 <- renderRef v3+    dv4 <- renderRef v4+    pure $ parens $ "tuple5" <+> dv0 <+> dv1 <+> dv2 <+> dv3 <+> dv4++  renderRef (OTuple6 v0 v1 v2 v3 v4 v5) = do+    dv0 <- renderRef v0+    dv1 <- renderRef v1+    dv2 <- renderRef v2+    dv3 <- renderRef v3+    dv4 <- renderRef v4+    dv5 <- renderRef v5+    pure $ parens $ "tuple6" <+> dv0 <+> dv1 <+> dv2 <+> dv3 <+> dv4 <+> dv5++-- Util+    +-- | "<name>" -> decode <name>+renderSumCondition :: T.Text -> Doc -> Reader TypeMetaData Doc+renderSumCondition name contents = do+  ao <- asks (aesonOptions . userOptions)+  let jsonConstructorName = T.pack . Aeson.constructorTagModifier ao . T.unpack $ name+  pure $ "|" <+> dquotes (stext jsonConstructorName) <+> "->" <$$>+    indent 3 contents++-- | Render a sum type constructor in context of a data type with multiple+-- constructors.+renderSum :: OCamlConstructor -> Reader TypeMetaData Doc+renderSum (OCamlValueConstructor (NamedConstructor name OCamlEmpty)) = renderSumCondition name ("Js_result.Ok" <+> stext name) +renderSum (OCamlValueConstructor (NamedConstructor name v@(Values _ _))) = do+  val <- rArgs name v+  renderSumCondition name val++renderSum (OCamlValueConstructor (NamedConstructor name value)) = do+  ao <- asks (aesonOptions . userOptions)+  let jsonConstructorName = T.pack . Aeson.constructorTagModifier ao . T.unpack $ name+  val <- render value+  renderSumCondition name $ parens+    ("match Aeson.Decode." <> parens ("field \"contents\"" <+> val <+> "json") <+> "with"+      <$$>+        indent 1+          (    "| v -> Js_result.Ok (" <> (stext name) <+> "v)"+          <$$> "| exception Aeson.Decode.DecodeError message -> Js_result.Error (\"" <> (stext jsonConstructorName) <> ": \" ^ message)"+          )           <> line+    )++renderSum (OCamlValueConstructor (RecordConstructor name value)) = do+  val <- render value+  renderSumCondition name val++renderSum (OCamlValueConstructor (MultipleConstructors constrs)) =+  foldl1 (<$+$>) <$> mapM (renderSum . OCamlValueConstructor) constrs++renderSum (OCamlSumOfRecordConstructor typeName (RecordConstructor name _value)) =+  renderOutsideEncoder typeName name++renderSum (OCamlSumOfRecordConstructor typeName (MultipleConstructors constrs)) =+  foldl1 (<$+$>) <$> mapM renderSum (OCamlSumOfRecordConstructor typeName <$> constrs)++renderSum (OCamlEnumeratorConstructor _) = pure "" -- handled elsewhere+renderSum _ = pure ""++renderOutsideEncoder :: Text -> Text -> Reader TypeMetaData Doc+renderOutsideEncoder typeName name =+  pure $+        "|" <+> (dquotes . stext $ name) <+> "->"+   <$$> indent 3 ("(match" <+> "decode" <> (stext $ typeName <> textUppercaseFirst name) <+> "json" <+> "with"+   <$$> indent 1 ("| Js_result.Ok v -> Js_result.Ok" <+> (parens ((stext $ textUppercaseFirst name) <+> "v"))+   <$$> "| Js_result.Error message -> Js_result.Error" <+> (parens $ (dquotes $ "decode" <> stext typeName <> ": ") <+> "^ message"))+   <$$> ")")+++flattenOCamlValue :: OCamlValue -> [OCamlValue]+flattenOCamlValue (Values l r) = flattenOCamlValue l ++ flattenOCamlValue r+flattenOCamlValue val = [val]++-- | Render the decoding of a constructor's arguments. Note the constructor must+-- be from a data type with multiple constructors and that it has multiple+-- constructors itself.+rArgs :: Text -> OCamlValue -> Reader TypeMetaData Doc+rArgs name vals = do+  v <- mk name 0 $ (Just <$> flattenOCamlValue vals) ++ [Nothing]+  pure $+    parens $ "match Aeson.Decode.(field \"contents\" Js.Json.decodeArray json) with"+    <$$> (indent 1 "| Some v ->"+    <$$> (indent 3 v)+    <$$> (indent 1 "| None -> Js_result.Error (\"" <> (stext name) <+> "expected an array.\")" )) <> line++mk :: Text -> Int -> [Maybe OCamlValue] -> Reader TypeMetaData Doc+mk name i [x] =+  case x of+    Nothing -> do+      let ts = foldl (<>) "" $ L.intersperse ", " ((stext . T.append "v" . T.pack . show) <$> [0..i-1])+      pure $ indent 1 $ "Js_result.Ok" <+> parens (stext name <+> parens ts)+    Just _ -> pure ""+mk name i (x:xs) =+  case x of+    Nothing -> mk name i xs+    Just x' -> do+      renderedVal <- render x'+      renderedInternal <- mk name (i+1) xs+      let iDoc = (stext . T.pack . show $ i)+      pure $ indent 1 $ "(match Aeson.Decode." <> renderedVal <+> ("v." <> parens iDoc) <+> "with"+        <$$>+          indent 1+            ("| v" <> iDoc <+> "->" <$$> (indent 2 renderedInternal)+            <$$> "| exception Aeson.Decode.DecodeError message -> Js_result.Error (\"" <> (stext name) <> ": \" ^ message)"+            )+        <$$> ")"++mk _name _i [] = pure ""++renderTypeParameterValsAux :: [OCamlValue] -> (Doc,Doc)+renderTypeParameterValsAux ocamlValues =+  let typeParameterNames = (<>) "'" <$> getTypeParameterRefNames ocamlValues+      typeDecs = (foldl (<>) "" $ L.intersperse " -> " $ (\t -> "(Js_json.t -> (" <> (stext t) <> ", string) Js_result.t)") <$> typeParameterNames) <> " -> "+  in+      if length typeParameterNames > 0+      then+        if length typeParameterNames > 1+          then (typeDecs, foldl (<>) "" $ ["("] <> (L.intersperse ", " $ stext <$> typeParameterNames) <> [") "])+          else (typeDecs, stext . flip (<>) " " . head $ typeParameterNames)+      else ("","")++renderTypeParameterVals :: OCamlConstructor -> (Doc,Doc)+renderTypeParameterVals (OCamlValueConstructor vc) = renderTypeParameterValsAux $ getOCamlValues vc+renderTypeParameterVals (OCamlSumOfRecordConstructor _ vc) = renderTypeParameterValsAux $ getOCamlValues vc+renderTypeParameterVals _ = ("","")+++renderTypeParametersAux :: [OCamlValue] -> (Doc,Doc)+renderTypeParametersAux ocamlValues = do+  let typeParameterNames = getTypeParameterRefNames ocamlValues+      typeDecs = (\t -> "(type " <> (stext t) <> ")") <$> typeParameterNames :: [Doc]+      encoderDecs  = (\t -> "(decode" <> (stext $ textUppercaseFirst t) <+> ":" <+> "Js_json.t -> (" <> (stext t) <> ", string) Js_result.t)" ) <$> typeParameterNames :: [Doc]+      typeParams = foldl (<>) "" $ if length typeParameterNames > 1 then  ["("] <> (L.intersperse ", " $ stext <$> typeParameterNames) <> [") "] else ((\x -> stext $ x <> " ") <$> typeParameterNames) :: [Doc]+  (foldl (<+>) "" (typeDecs ++ encoderDecs), typeParams )++getOCamlValues :: ValueConstructor -> [OCamlValue]+getOCamlValues (NamedConstructor     _ value) = [value]+getOCamlValues (RecordConstructor    _ value) = [value]+getOCamlValues (MultipleConstructors cs)      = concat $ getOCamlValues <$> cs++renderTypeParameters :: OCamlConstructor -> (Doc,Doc)+renderTypeParameters (OCamlValueConstructor vc) = renderTypeParametersAux $ getOCamlValues vc+renderTypeParameters (OCamlSumOfRecordConstructor _ vc) = renderTypeParametersAux $ getOCamlValues vc+renderTypeParameters _ = ("","")++-- | Render an OCaml val interface for a record constructor in a sum of records+renderSumRecordInterface :: Text -> OCamlConstructor -> Maybe Doc+renderSumRecordInterface typeName (OCamlValueConstructor (RecordConstructor name _value)) =+  Just $ "val decode" <> (stext $ typeName <> name) <+> ":" <+> "Js_json.t" <+> "->" <+> parens (stext (textLowercaseFirst $ typeName <> name) <> comma <+> "string") <+> "Js_result.t"+renderSumRecordInterface _ _ = Nothing+++-- Exported++-- | Convert a 'Proxy a' into OCaml type to decode JSON function source code with an interface file '.mli'.+toOCamlDecoderInterfaceWith :: forall a. OCamlType a => Options -> a -> T.Text+toOCamlDecoderInterfaceWith options a =+  case toOCamlType (Proxy :: Proxy a) of+    OCamlDatatype haskellTypeMetaData _ _ ->+      case Map.lookup haskellTypeMetaData (dependencies options) of+        Just ocamlTypeMetaData -> pprinter $ runReader (renderInterface (toOCamlType a)) (TypeMetaData (Just ocamlTypeMetaData) options)+        Nothing -> ""          +    _ -> pprinter $ runReader (renderInterface (toOCamlType a)) (TypeMetaData Nothing options)++-- | Convert a 'Proxy a' into OCaml type to decode JSON function source code without an interface file '.mli'.+toOCamlDecoderSourceWith :: forall a. OCamlType a => Options -> a -> T.Text+toOCamlDecoderSourceWith options a =+  case toOCamlType (Proxy :: Proxy a) of+    OCamlDatatype haskellTypeMetaData _ _ ->+      case Map.lookup haskellTypeMetaData (dependencies options) of+        Just ocamlTypeMetaData -> pprinter $ runReader (render (toOCamlType a)) (TypeMetaData (Just ocamlTypeMetaData) options)+        Nothing -> ""+    _ -> pprinter $ runReader (render (toOCamlType a)) (TypeMetaData Nothing options)

@@ -0,0 +1,497 @@+{-|+Module      : OCaml.BuckleScript.Encode+Description : Make a JSON encoder for an OCamlDatatype that matches Generic aeson ToJSON+Copyright   : Plow Technologies, 2017+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : experimental++For a Haskell type with an instance of OCamlType, output an+OCaml type to JSON (aeson) encoder.+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module OCaml.BuckleScript.Encode +  ( toOCamlEncoderSourceWith+  , toOCamlEncoderInterfaceWith+  ) where++-- base+import Control.Monad.Reader+import qualified Data.List as L+import Data.Maybe (catMaybes)+import Data.Monoid+import Data.Proxy (Proxy (..))++-- aeson+import qualified Data.Aeson.Types as Aeson (Options(..))++-- containers+import qualified Data.Map as Map++-- text+import Data.Text (Text)+import qualified Data.Text as T++-- wl-pprint+import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>))++-- ocaml-export+import OCaml.BuckleScript.Types+import OCaml.Internal.Common++-- | Render the encoder function+class HasEncoder a where+  render :: a -> Reader TypeMetaData Doc++-- | Render the encode type signature+class HasEncoderRef a where+  renderRef :: a -> Reader TypeMetaData Doc++-- | Render the encoder interface+class HasEncoderInterface a where+  renderTypeInterface :: a -> Reader TypeMetaData Doc+++instance HasEncoderInterface OCamlDatatype where+  -- sum that has at least one record type+  renderTypeInterface datatype@(OCamlDatatype _ typeName constructor@(OCamlSumOfRecordConstructor _ (MultipleConstructors constructors))) = do+    fnName <- renderRef datatype+    let (typeParameterSignatures,typeParameters) = renderTypeParameterVals constructor+        sumRecordDeclarations = linesBetween $ catMaybes (renderSumRecordInterface typeName . OCamlValueConstructor <$> constructors)+        encodeFnName = stext . textLowercaseFirst $ typeName+    pure $ sumRecordDeclarations+      <$$> "val" <+> fnName <+> ":" <+> typeParameterSignatures <+> typeParameters <> encodeFnName <+> "->" <+> "Js_json.t"+    +  -- other data types+  renderTypeInterface datatype@(OCamlDatatype _ typeName constructor) = do+    fnName <- renderRef datatype+    let (typeParameterSignatures,typeParameters) = renderTypeParameterVals constructor+        encodeFnName = stext . textLowercaseFirst $ typeName+    pure $ "val" <+> fnName <+> ":" <+> typeParameterSignatures <+> typeParameters <> encodeFnName <+> "->" <+> "Js_json.t"++  -- no need to render for primitives+  renderTypeInterface _ = pure ""++instance HasEncoder OCamlDatatype where+  -- sum that has at least one record constructor+  render datatype@(OCamlDatatype _ typeName constructor@(OCamlSumOfRecordConstructor _ (MultipleConstructors constructors))) = do+    ocamlInterface <- asks (includeOCamlInterface . userOptions)+    fnName <- renderRef datatype+    typeParameterDeclarations <- linesBetween <$> catMaybes <$> sequence (renderSumRecord typeName . OCamlValueConstructor <$> constructors)+    fnBody <- mapM renderSum (OCamlSumOfRecordConstructor typeName <$> constructors)+    +    if ocamlInterface+      then do+       let typeParameters = renderEncodeTypeParameters constructor+       pure $ typeParameterDeclarations+         <$$> ("let" <+> fnName <+> typeParameters <+> "x =")+         <$$> (indent 2 ("match x with" <$$> foldl1 (<$$>) fnBody))+      else do+        let (typeParameterSignatures,typeParameters) = renderTypeParameters constructor+            encodeFnName = stext $ textLowercaseFirst typeName+        pure $ typeParameterDeclarations+          <$$> ("let" <+> fnName <+> typeParameterSignatures <+> "(x :" <+> typeParameters <> encodeFnName <> ") :Js_json.t =")+          <$$> (indent 2 ("match x with" <$$> foldl1 (<$$>) fnBody))++  -- sum+  render datatype@(OCamlDatatype _ typeName constructor@(OCamlValueConstructor (MultipleConstructors constructors))) = do+    ocamlInterface <- asks (includeOCamlInterface . userOptions)+    fnName <- renderRef datatype+    dc <- mapM renderSum (OCamlValueConstructor <$> constructors)+    if ocamlInterface+      then do+        let encodeTypeParameters = renderEncodeTypeParameters constructor+        pure $+          ("let" <+> fnName <+> encodeTypeParameters <+> "x =") <$$>+          (indent 2 ("match x with" <$$> foldl1 (<$$>) dc))+      else do+        let (typeParameterSignatures,typeParameters) = renderTypeParameters constructor+            encodeFnName = stext $ textLowercaseFirst typeName+        pure $+          ("let" <+> fnName <+> typeParameterSignatures <+> "(x :" <+> typeParameters <> encodeFnName <> ") :Js_json.t =") <$$>+          (indent 2 ("match x with" <$$> foldl1 (<$$>) dc))++  -- product or record+  render datatype@(OCamlDatatype _ typeName constructor) = do+    ocamlInterface <- asks (includeOCamlInterface . userOptions)+    fnName <- renderRef datatype+    renderedConstructor <- render constructor+    if ocamlInterface+      then do+        let typeParameters = renderEncodeTypeParameters constructor+        pure $+          "let" <+> fnName <+> typeParameters <+> "x =" <$$> (indent 2 renderedConstructor)+      else do+        let (typeParameterSignatures,typeParameters) = renderTypeParameters constructor+            encodeFnName = stext $ textLowercaseFirst typeName+        pure $ "let" <+> fnName <+> typeParameterSignatures <+> "(x :" <+> typeParameters <> encodeFnName <> ") :Js_json.t ="+          <$$> indent 2 renderedConstructor++  -- primitive+  render (OCamlPrimitive primitive) = renderRef primitive++-- | produce encode function name for data types and primitives+instance HasEncoderRef OCamlDatatype where+  renderRef datatype@(OCamlDatatype typeRef name _) = do+    if isTypeParameterRef datatype+    then+      pure $ "encode" <> (stext . textUppercaseFirst $ name)+    else do+      mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData +      case mOCamlTypeMetaData of+        Nothing -> pure $ "encode" <> (stext . textUppercaseFirst $ name)+        Just decOCamlTypeMetaData -> do+          ds <- asks (dependencies . userOptions)+          case Map.lookup typeRef ds of+            Just parOCamlTypeMetaData -> do+              let prefix = stext $ mkModulePrefix decOCamlTypeMetaData parOCamlTypeMetaData+              pure $ prefix <> "encode" <> (stext . textUppercaseFirst $ name)++            -- in case of a Haskell sum of products, ocaml-export creates a definition for each product+            -- within the same file as the sum. These products will not be in the dependencies map.+            Nothing -> pure $ "encode" <> (stext . textUppercaseFirst $ name)++  renderRef (OCamlPrimitive primitive) = renderRef primitive++instance HasEncoder OCamlConstructor where+  -- Single constructor, no values: empty array+  render (OCamlValueConstructor (NamedConstructor _name OCamlEmpty)) =+    pure $ "Aeson.Encode.list []"++  -- Single constructor, multiple values: create array with values+  render (OCamlValueConstructor (NamedConstructor name value)) = do+    let constructorParams = constructorParameters 0 value+    (encoders, _) <- renderVariable constructorParams value+    +    let encoders' =+          if length constructorParams > 1+          then "Aeson.Encode.array" <+> arraybrackets encoders+          else encoders+        constructorParams' =+          if length constructorParams > 1+          then ["("] <> (L.intersperse "," constructorParams) <> [")"]+          else (L.intersperse "," constructorParams)++    pure $ "match x with" <$$>+      "|" <+> stext name <+> foldl1 (<>) constructorParams' <+> "->" <$$> indent 3 encoders'++  -- Record constructor+  render (OCamlValueConstructor (RecordConstructor _ value)) = do+    recordValue <- render value+    pure . nest 2 $ "Aeson.Encode.object_" <$$> "[" <+> recordValue <$$> "]"++  -- Sum+  render (OCamlValueConstructor (MultipleConstructors constrs)) = do+    sums <- mapM renderSum (OCamlValueConstructor <$> constrs)+    pure $ "match x with" <$$> foldl1 (<$$>) sums++  -- Enumerator+  render ec@(OCamlEnumeratorConstructor _constructors) =+    (<$$>) "match x with" <$> renderSum ec++  render _  = return ""+++-- | special rendering function for sum with record types+renderSumRecord :: Text -> OCamlConstructor -> Reader TypeMetaData (Maybe Doc)+renderSumRecord typeName (OCamlValueConstructor (RecordConstructor name value)) = do+  ocamlInterface <- asks (includeOCamlInterface . userOptions)+  let sumRecordName = typeName <> name+  sumRecordBody <- render (OCamlValueConstructor $ RecordConstructor sumRecordName value)+  if ocamlInterface+    then+      pure $ Just $ "let encode" <> stext sumRecordName <+> "x ="+        <$$> indent 2 sumRecordBody+    else+      pure $ Just $ "let encode" <> stext sumRecordName <+> "(x : " <> (stext $ textLowercaseFirst sumRecordName) <> ") :Js_json.t ="+        <$$> indent 2 sumRecordBody++renderSumRecord _ _ = return Nothing++-- | special rendering function for an encoders interface+renderSumRecordInterface :: Text -> OCamlConstructor -> Maybe Doc+renderSumRecordInterface typeName (OCamlValueConstructor (RecordConstructor name _value)) =+  let sumRecordName = typeName <> name +  in Just $ "val encode" <> stext sumRecordName <+> ":" <+> (stext . textLowercaseFirst $ sumRecordName) <+> "->" <+> "Js_json.t"+renderSumRecordInterface _ _ = Nothing++-- |+renderSumOfRecordEncoder :: Text -> Text -> Reader TypeMetaData Doc+renderSumOfRecordEncoder typeName name = do+  ao <- asks (aesonOptions . userOptions)+  let jsonConstructorName = T.pack . Aeson.constructorTagModifier ao . T.unpack $ name+  pure $+         "|" <+> stext name <+> "y0 ->"+    <$$> "   (match (Js.Json.decodeObject (encode" <> (stext . textUppercaseFirst $ typeName) <> stext name <+> "y0)) with"+    <$$> "    | Some dict ->"+    <$$> "       Js.Dict.set dict \"tag\" (Js.Json.string \"" <> stext jsonConstructorName <> "\");"+    <$$> "       Js.Json.object_ dict"+    <$$> "    | None ->"+    <$$> "       Aeson.Encode.object_ []"+    <$$> "   )"++-- | render product values+jsonEncodeObject :: Doc -> Doc -> Maybe Doc -> Doc+jsonEncodeObject constructor tag mContents =+  case mContents of+    Nothing -> constructor <$$> indent 3 ("Aeson.Encode.object_" <$$> indent 2 ("[" <+> tag <$$> "]"))+    Just contents -> constructor <$$> indent 3 ("Aeson.Encode.object_" <$$> indent 2 ("[" <+> tag <$$> contents <$$> "]"))++-- | render body rules for sum types+renderSum :: OCamlConstructor -> Reader TypeMetaData Doc+renderSum (OCamlValueConstructor (NamedConstructor name OCamlEmpty)) = do+  ao <- asks (aesonOptions . userOptions)+  let jsonConstructorName = T.pack . Aeson.constructorTagModifier ao . T.unpack $ name+      constructorMatchCase = "|" <+> stext name <+> "->"+      encodeTag = pair (dquotes "tag") ("Aeson.Encode.string" <+> dquotes (stext jsonConstructorName))+  pure $ jsonEncodeObject constructorMatchCase encodeTag Nothing++renderSum (OCamlValueConstructor (NamedConstructor name value)) = do+  let constructorParams = constructorParameters 0 value+  ao <- asks (aesonOptions . userOptions)+  let jsonConstructorName = T.pack . Aeson.constructorTagModifier ao . T.unpack $ name+  (encoders, _) <- renderVariable constructorParams value+  let encoders' =+        if length constructorParams > 1+        then "Aeson.Encode.array" <+> arraybrackets encoders+        else encoders+      constructorParams' =+        if length constructorParams > 1+        then ["("] <> (L.intersperse "," constructorParams) <> [")"]+        else (L.intersperse "," constructorParams)+      constructorMatchCase  = "|" <+> stext name <+> foldl1 (<>) constructorParams' <+> "->"+      encodeTag = pair (dquotes "tag") ("Aeson.Encode.string" <+> dquotes (stext jsonConstructorName))+      encodeContents  = ";" <+> pair (dquotes "contents") encoders'++  pure $ jsonEncodeObject constructorMatchCase encodeTag (Just encodeContents)++renderSum (OCamlValueConstructor (RecordConstructor name value)) = do+  ao <- asks (aesonOptions . userOptions)+  let jsonConstructorName = T.pack . Aeson.constructorTagModifier ao . T.unpack $ name+  encoder <- render value+  let constructorMatchCase = "|" <+> stext name <+> "->"+      encodeTag = pair (dquotes "tag") (dquotes $ stext jsonConstructorName)+      encodeContents = comma <+> encoder+  pure $ jsonEncodeObject constructorMatchCase encodeTag (Just encodeContents)++renderSum (OCamlValueConstructor (MultipleConstructors constructors)) = do+  encoders <- mapM renderSum (OCamlValueConstructor <$> constructors)+  pure $ foldl1 (<$$>) encoders++renderSum (OCamlSumOfRecordConstructor typeName (RecordConstructor name _value)) = do+  renderSumOfRecordEncoder typeName name+  +renderSum (OCamlSumOfRecordConstructor typeName (MultipleConstructors constructors)) = do+  encoders <- mapM renderSum (OCamlSumOfRecordConstructor typeName <$> constructors)+  pure $ foldl1 (<$$>) encoders++renderSum (OCamlEnumeratorConstructor constructors) =+  pure $ foldl1 (<$$>) $ (\(EnumeratorConstructor name) -> "|" <+> stext name <+> "->" <$$> "   Aeson.Encode.string" <+> dquotes (stext name)) <$> constructors++renderSum _ = return ""++instance HasEncoder OCamlValue where+  render (OCamlField name value) = do+    valueBody <- render value+    ao <- asks (aesonOptions . userOptions)+    let jsonFieldname = T.pack . Aeson.fieldLabelModifier ao . T.unpack $ name+    return . spaceparens $+      dquotes (stext jsonFieldname) <> comma <+>+      (valueBody <+> "x." <> stext name)+  render (OCamlTypeParameterRef name) =+    pure $ "encode" <> (stext . textUppercaseFirst $ name)+  render (OCamlPrimitiveRef primitive) = renderRef primitive+  render ref@(OCamlRef typeRef name) = do+    mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData+    case mOCamlTypeMetaData of+      Nothing -> fail $ "OCaml.BuckleScript.Encode (HasEncoder (OCamlRef typeRep name)) mOCamlTypeMetaData is Nothing:\n\n" ++ (show ref)+      Just decOCamlTypeMetaData -> do+        ds <- asks (dependencies . userOptions)+        case Map.lookup typeRef ds of+          Just parOCamlTypeMetaData -> do+            let prefix = stext $ mkModulePrefix decOCamlTypeMetaData parOCamlTypeMetaData+            pure $ prefix <> "encode" <> (stext . textUppercaseFirst $ name)++          -- in case of a Haskell sum of products, ocaml-export creates a definition for each product+          -- within the same file as the sum. These products will not be in the dependencies map.+          Nothing -> pure $ "encode" <> (stext . textUppercaseFirst $ name)++  render (Values x y) = do+    dx <- render x+    dy <- render y+    return $ dx <$$> ";" <+> dy+  render _ = error "HasEncoderRef OCamlValue: should not happen"++instance HasEncoderRef OCamlPrimitive where+  renderRef ODate   = pure "Aeson.Encode.date"+  renderRef OUnit   = pure "Aeson.Encode.null"+  renderRef OInt    = pure "Aeson.Encode.int"+  renderRef OChar   = pure "Aeson.Encode.string"+  renderRef OBool   = pure "Aeson.Encode.boolean"+  renderRef OFloat  = pure "Aeson.Encode.float"+  renderRef OString = pure "Aeson.Encode.string"+  renderRef (OList (OCamlPrimitive OChar)) = pure "Aeson.Encode.string"++  renderRef (OList datatype) = do+    dd <- renderRef datatype+    return . parens $ "Aeson.Encode.list" <+> dd++  renderRef (OOption datatype) = do+    dd <- renderRef datatype+    return $ "Aeson.Encode.optional" <+> dd++  renderRef (OEither t0 t1) = do+    dt0 <- renderRef t0+    dt1 <- renderRef t1+    return $ "Aeson.Encode.either" <+> dt0 <+> dt1++  renderRef (OTuple2 t0 t1) = do+    dt0 <- renderRef t0+    dt1 <- renderRef t1+    return $ "Aeson.Encode.pair" <+> dt0 <+> dt1++  renderRef (OTuple3 t0 t1 t2) = do+    dt0 <- renderRef t0+    dt1 <- renderRef t1+    dt2 <- renderRef t2+    return $ "Aeson.Encode.tuple3" <+> dt0 <+> dt1 <+> dt2++  renderRef (OTuple4 t0 t1 t2 t3) = do+    dt0 <- renderRef t0+    dt1 <- renderRef t1+    dt2 <- renderRef t2+    dt3 <- renderRef t3+    return $ "Aeson.Encode.tuple4" <+> dt0 <+> dt1 <+> dt2 <+> dt3+    +  renderRef (OTuple5 t0 t1 t2 t3 t4) = do+    dt0 <- renderRef t0+    dt1 <- renderRef t1+    dt2 <- renderRef t2+    dt3 <- renderRef t3+    dt4 <- renderRef t4+    return $ "Aeson.Encode.tuple5" <+> dt0 <+> dt1 <+> dt2 <+> dt3 <+> dt4++  renderRef (OTuple6 t0 t1 t2 t3 t4 t5) = do+    dt0 <- renderRef t0+    dt1 <- renderRef t1+    dt2 <- renderRef t2+    dt3 <- renderRef t3+    dt4 <- renderRef t4+    dt5 <- renderRef t5+    return $ "Aeson.Encode.tuple6" <+> dt0 <+> dt1 <+> dt2 <+> dt3 <+> dt4 <+> dt5++-- | Variable names for the members of constructors+--   Used in pattern matches+constructorParameters :: Int -> OCamlValue -> [Doc]+constructorParameters _ OCamlEmpty = [ empty ]+constructorParameters i (Values l r) =+    left ++ right+  where+    left = constructorParameters i l+    right = constructorParameters (length left + i) r+constructorParameters i _ = [ "y" <> int i ]+++-- | render JSON encoders for OCamlValues. It runs recersively on Values.+--   [Doc] helps build encoders for arrays and tuples+--   should only use fst of return type, snd [Doc] is to help with recursion+renderVariable :: [Doc] -> OCamlValue -> Reader TypeMetaData (Doc, [Doc])+renderVariable (d : ds) v@(OCamlRef {}) = do+  v' <- render v+  return (v' <+> d, ds)+renderVariable ds OCamlEmpty = return (empty, ds)+renderVariable (_ : ds) (OCamlPrimitiveRef OUnit) =+  return ("Aeson.Encode.null", ds)+renderVariable (d : ds) (OCamlPrimitiveRef ref) = do+  r <- renderRef ref+  return (r <+> d, ds)+renderVariable (d : ds) ref@(OCamlTypeParameterRef _) = do+  r <- render ref+  return (r <+> d, ds)+renderVariable ds (Values l r) = do+  (left, dsl) <- renderVariable ds l+  (right, dsr) <- renderVariable dsl r+  return (left <+> ";" <+> right, dsr)+renderVariable ds f@(OCamlField _ _) = do+  f' <- render f+  return (f', ds)+renderVariable [] _ = error "Amount of variables does not match variables."++-- Util++-- | For an OCamlConstructor, get its OCamlValues as a list, if it has+--   type parameters, render the encoder type signatures for each type parameter+--   as `('a0 -> Js_json.t)` and `'a0`. This is for the interface.+--   fst Doc is type parameter encoder signature+--   snd Doc is list of type parameters which will be rendered as part of the main+--   type's values.+--   For `Either a b`: `("('a0 -> Js_json.t) ('a1 -> Js_json.t)","('a0, 'a1)")`+renderTypeParameterVals :: OCamlConstructor -> (Doc,Doc)+renderTypeParameterVals (OCamlValueConstructor vc) = renderTypeParameterValsAux $ getOCamlValues vc+renderTypeParameterVals (OCamlSumOfRecordConstructor _ vc) = renderTypeParameterValsAux $ getOCamlValues vc+renderTypeParameterVals _ = ("","")++-- | Helper function for renderTypeParameterVals+renderTypeParameterValsAux :: [OCamlValue] -> (Doc,Doc)+renderTypeParameterValsAux ocamlValues =+  let typeParameterNames = (<>) "'" <$> getTypeParameterRefNames ocamlValues+      typeDecs = (\t -> "(" <> (stext t) <+> "-> Js_json.t)") <$> typeParameterNames+  in+      if length typeDecs > 0+      then+        let ts =+              if length typeParameterNames > 1+              then foldl (<>) "" $ ["("] <> (L.intersperse ", " $ stext <$> typeParameterNames) <> [") "]+              else+                -- `flip (<>) " "` means add a space to the end+                if length typeParameterNames == 1 then stext . flip (<>) " " . head $ typeParameterNames+                else ""+        in ((foldl (<>) "" $  (L.intersperse " -> " typeDecs)) <> " ->", ts)+      else ("","")++-- | Render type parameters as encode functions. This is for a let declaration that has+--   a complete type signature.+--   `Either a b` : `("(encodeA0 : 'a0 -> Js_json.t) (encodeA0 : 'a1 -> Js_json.t)", "('a0, 'a1)")`+renderTypeParameters :: OCamlConstructor -> (Doc,Doc)+renderTypeParameters (OCamlValueConstructor vc) = renderTypeParametersAux $ getOCamlValues vc+renderTypeParameters (OCamlSumOfRecordConstructor _ vc) = renderTypeParametersAux $ getOCamlValues vc+renderTypeParameters _ = ("","")++-- | Helper function for renderTypeParameters+renderTypeParametersAux :: [OCamlValue] -> (Doc,Doc)+renderTypeParametersAux ocamlValues = do+  let typeParameterNames = getTypeParameterRefNames ocamlValues+      typeDecs = (\t -> "(type " <> (stext t) <> ")") <$> typeParameterNames :: [Doc]+      parserDecs  = (\t -> "(encode" <> (stext $ textUppercaseFirst t) <+> ":" <+> (stext t) <+> "-> Js_json.t)" ) <$> typeParameterNames :: [Doc]+      typeParams = foldl (<>) "" $ if length typeParameterNames > 1 then  ["("] <> (L.intersperse ", " $ stext <$> typeParameterNames) <> [") "] else ((\x -> stext $ x <> " ") <$> typeParameterNames) :: [Doc]+  (foldl (<+>) "" (typeDecs ++ parserDecs), typeParams )++-- | render type parameter encoder names for all of a constructors type parameters+--   `Either a b`: `"encodeA0 encodeA1"`+renderEncodeTypeParameters :: OCamlConstructor -> Doc+renderEncodeTypeParameters constructor =+  foldl (<>) "" $ stext <$> L.intersperse " " ((\t -> "encode" <> (textUppercaseFirst t)) <$> getTypeParameters constructor)+++-- | Convert a 'Proxy a' into OCaml type to JSON function source code which expects an interface file '.ml'.+toOCamlEncoderInterfaceWith :: forall a. OCamlType a => Options -> a -> T.Text+toOCamlEncoderInterfaceWith options a =+  case toOCamlType (Proxy :: Proxy a) of+    OCamlDatatype haskellTypeMetaData _ _ ->+      case Map.lookup haskellTypeMetaData (dependencies options) of+        Just ocamlTypeMetaData -> pprinter $ runReader (renderTypeInterface (toOCamlType a)) (TypeMetaData (Just ocamlTypeMetaData) options)+        Nothing -> ""          +    _ -> pprinter $ runReader (renderTypeInterface (toOCamlType a)) (TypeMetaData Nothing options)++-- | Convert a 'Proxy a' into OCaml type to JSON function source code without an interface file '.mli'.+toOCamlEncoderSourceWith :: forall a. OCamlType a => Options -> a -> T.Text+toOCamlEncoderSourceWith options a =+  case toOCamlType (Proxy :: Proxy a) of+    OCamlDatatype haskellTypeMetaData _ _ ->+      case Map.lookup haskellTypeMetaData (dependencies options) of+        Just ocamlTypeMetaData -> pprinter $ runReader (render (toOCamlType a)) (TypeMetaData (Just ocamlTypeMetaData) options)+        Nothing -> ""+    _ -> pprinter $ runReader (render (toOCamlType a)) (TypeMetaData Nothing options)

@@ -0,0 +1,239 @@+{-|+Module      : OCaml.BuckleScript.Internal.Module+Description : Build OCaml Modules from Haskell Types+Copyright   : Plow Technologies, 2017+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : experimental++-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module OCaml.BuckleScript.Internal.Module+  (+  -- define an OCamlModule with servant style types+    OCamlModule+  , OCamlSubModule+  , OCamlTypeInFile++  , EmbeddedOCamlFiles (..)++  , HasOCamlType (..)+  +  -- template haskell+  -- load OCamlTypeInFile files at compile time+  , HasEmbeddedFile (..)+  ) where++-- base+import Data.Monoid ((<>))+import Data.Proxy (Proxy (..))+import Data.Typeable (Typeable, typeRep, typeRepTyCon, tyConName, splitTyConApp) +import GHC.TypeLits (Nat, Symbol, KnownSymbol, symbolVal)++-- bytestring+import Data.ByteString (ByteString)++-- containers+import qualified Data.Map.Strict as Map++-- directory+-- import System.Directory (createDirectoryIfMissing)++-- file-embed+import Data.FileEmbed (embedFile)++-- filepath+import System.FilePath.Posix ((<.>)) -- ((</>), (<.>))++-- ocaml-export+import OCaml.Internal.Common hiding ((</>))+import OCaml.BuckleScript.Decode+import OCaml.BuckleScript.Encode+import OCaml.BuckleScript.Record+import OCaml.BuckleScript.Spec+import OCaml.BuckleScript.Types++-- servant+import Servant.API ((:>))++-- template-haskell+import Language.Haskell.TH++-- text+import Data.Text (Text)+import qualified Data.Text as T+-- import qualified Data.Text.IO as T+import Data.Text.Encoding (decodeUtf8)+++-- ==============================================+-- Types+-- ==============================================++-- | An OCamlModule as a Haskell type. File level 'modules' is relative to a+--   root directory prvoiided in the 'mkPackage' function. +data OCamlModule (modules :: [Symbol])+  deriving Typeable++-- | Symobl will be expaneded to +--   "module SymbolName = struct ... end".+data OCamlSubModule (subModules :: Symbol)+  deriving Typeable++-- | A handwritten OCaml type, encoder and decoder from a file.+data OCamlTypeInFile a (filePath :: Symbol)+  deriving Typeable+++-- ==============================================+-- Data Types+-- ==============================================++-- | Store OCamlFileInType data.+data EmbeddedOCamlFiles =+  EmbeddedOCamlFiles+    { eocDeclaration :: ByteString+    , eocInterface   :: Maybe ByteString+    , eocSpec        :: Maybe ByteString+    }++++++-- ==============================================+-- Type Level Functions+-- ==============================================++-- | Convert a Haskell type into OCaml source code.+class HasOCamlType api where+  mkType :: Proxy api -> Options -> Bool -> Map.Map String EmbeddedOCamlFiles -> [Text]+  mkInterface :: Proxy api -> Options -> Map.Map String EmbeddedOCamlFiles -> [Text]+  mkSpec :: Proxy api -> Options -> [Text] -> Text -> Text -> Map.Map String EmbeddedOCamlFiles -> [Text]++instance (HasOCamlTypeFlag a ~ flag, HasOCamlType' flag (a :: *)) => HasOCamlType a where+  mkType = mkType' (Proxy :: Proxy flag)+  mkInterface = mkInterface' (Proxy :: Proxy flag)+  mkSpec = mkSpec' (Proxy :: Proxy flag)++type family (HasOCamlTypeFlag a) :: Nat where+  HasOCamlTypeFlag (OCamlSubModule a :> b) = 4+  HasOCamlTypeFlag (a :> b) = 3+  HasOCamlTypeFlag (OCamlTypeInFile a b) = 2+  HasOCamlTypeFlag a = 1++-- | Helper function to work avoid overlapped instances.+class HasOCamlType' (flag :: Nat) api where+  mkType' :: Proxy flag -> Proxy api -> Options -> Bool -> Map.Map String EmbeddedOCamlFiles -> [Text]+  mkInterface' :: Proxy flag -> Proxy api -> Options -> Map.Map String EmbeddedOCamlFiles -> [Text]+  mkSpec' :: Proxy flag -> Proxy api -> Options -> [Text] -> Text -> Text -> Map.Map String EmbeddedOCamlFiles -> [Text]++instance (KnownSymbol subModule, HasOCamlType b) => HasOCamlType' 4 (OCamlSubModule subModule :> b) where+  mkType' _ Proxy options interface fileMap = ["module " <> (T.pack $ symbolVal (Proxy :: Proxy subModule)) <> " = struct\n"] <> (mkType (Proxy :: Proxy b) options interface fileMap) <> ["\nend"]++  mkInterface' _ Proxy options fileMap = ["module " <> (T.pack $ symbolVal (Proxy :: Proxy subModule)) <> " : sig\n"] <> (mkInterface (Proxy :: Proxy b) options fileMap) <> ["\nend"]++  mkSpec' _ Proxy options modules url goldendir fileMap = mkSpec (Proxy :: Proxy b) options modules url goldendir fileMap++instance (HasOCamlType a, HasOCamlType b) => HasOCamlType' 3 (a :> b) where+  mkType' _ Proxy options interface fileMap = (mkType (Proxy :: Proxy a) options interface fileMap) <> (mkType (Proxy :: Proxy b) options interface fileMap)+  mkInterface' _ Proxy options fileMap = (mkInterface (Proxy :: Proxy a) options fileMap) <> (mkInterface (Proxy :: Proxy b) options fileMap)+  mkSpec' _ Proxy options modules url goldendir fileMap = (mkSpec (Proxy :: Proxy a) options modules url goldendir fileMap) <> (mkSpec (Proxy :: Proxy b) options modules url goldendir fileMap)++instance (Typeable a) => HasOCamlType' 2 (OCamlTypeInFile a b) where+  mkType' _ Proxy _options _ fileMap = do+    let typeName = tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a)+    case eocDeclaration <$> Map.lookup typeName fileMap of+      Just v -> [decodeUtf8 v]+      _ -> fail $ "Unable to find the embedded file for " ++ typeName++  mkInterface' _ Proxy _options fileMap = do+    let typeName = tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a)+    case eocInterface <$> Map.lookup typeName fileMap of+      Just (Just v) -> [decodeUtf8 v]+      _ -> fail $ "Unable to find the embedded file for " ++ typeName++  mkSpec' _ Proxy _options modules url goldendir _fileMap = +    [typeInFileToOCamlSpec (T.pack . tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a)) typeParameterRefCount modules url goldendir]+    where+      parameters = fmap show . snd . splitTyConApp $ typeRep (Proxy :: Proxy a)+      inParameters = flip elem parameters+      xs =+        [ inParameters "TypeParameterRef0"+        , inParameters "TypeParameterRef1"+        , inParameters "TypeParameterRef2"+        , inParameters "TypeParameterRef3"+        , inParameters "TypeParameterRef4"+        , inParameters "TypeParameterRef5"+        , inParameters "TypeParameterRef6"+        ]+      countTrues = foldl (flip ((+) . fromEnum)) 0+      typeParameterRefCount = countTrues xs+      ++instance (OCamlType a) => HasOCamlType' 1 a where+  mkType' _ a options interface _ = body+    where+      body = [(toOCamlTypeSourceWith options a)+          , (toOCamlEncoderSourceWith (options {includeOCamlInterface = interface}) a)+          , (toOCamlDecoderSourceWith (options {includeOCamlInterface = interface}) a)]++  mkInterface' _ a options _ = body+    where+      body = [(toOCamlTypeSourceWith options a)+          , (toOCamlEncoderInterfaceWith options a) +          , (toOCamlDecoderInterfaceWith options a)]++  mkSpec' _ a _options modules url goldendir _ = [toOCamlSpec a modules url goldendir]+++++-- ==============================================+-- Template Haskell+-- ==============================================++-- | Use Template Haskell to load OCaml files for an OCaml Module at compile time.+--   '$(mkFile (Proxy :: Proxy Package))'.+class HasEmbeddedFile api where+  mkFiles :: Bool -> Bool -> Proxy api -> Q Exp++instance (HasEmbeddedFile' api) => HasEmbeddedFile api where+  mkFiles includeInterface includeSpec Proxy = ListE <$> mkFiles' includeInterface includeSpec (Proxy :: Proxy api)++-- | Help function for HasEmbeddedFile.+class HasEmbeddedFile' api where+  mkFiles' :: Bool -> Bool -> Proxy api -> Q [Exp]++instance (HasEmbeddedFile' a, HasEmbeddedFile' b) => HasEmbeddedFile' (a :> b) where+  mkFiles' includeInterface includeSpec Proxy = (<>) <$> mkFiles' includeInterface includeSpec (Proxy :: Proxy a) <*> mkFiles' includeInterface includeSpec (Proxy :: Proxy b)++instance (Typeable a, KnownSymbol b) => HasEmbeddedFile' (OCamlTypeInFile a b) where+  mkFiles' includeInterface includeSpec Proxy = do+    let typeFilePath = symbolVal (Proxy :: Proxy b)+    let typeName = tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a)+    ml  <- embedFile (typeFilePath <.> "ml")++    mli <- if includeInterface+      then (\f -> AppE (ConE $ mkName "Just") f) <$> embedFile (typeFilePath <.> "mli")+      else pure $ ConE $ mkName "Nothing"++    spec <- if includeSpec+      then (\f -> AppE (ConE $ mkName "Just") f) <$> embedFile (typeFilePath <> "_spec" <.> "ml")+      else pure $ ConE $ mkName "Nothing"++    pure [TupE [LitE $ StringL typeName, AppE (AppE (AppE (ConE $ mkName "EmbeddedOCamlFiles") ml) mli) spec]]++instance {-# OVERLAPPABLE #-} HasEmbeddedFile' a where+  mkFiles' _ _ Proxy = pure []

@@ -0,0 +1,268 @@+{-|+Module      : OCaml.BuckleScript.Internal.Package+Description : Build OCaml Modules from Haskell Types+Copyright   : Plow Technologies, 2017+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : experimental++-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE DeriveFoldable     #-}+{-# LANGUAGE DeriveTraversable  #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE KindSignatures  #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds  #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module OCaml.BuckleScript.Internal.Package+  (+  -- define an OCamlPackage with servant style types+    OCamlPackage+  , NoDependency++  +  , PackageOptions (..)+  , defaultPackageOptions+  , SpecOptions (..)+  , defaultSpecOptions++  , HasOCamlPackage (..)+  , HasOCamlModule (..)+  , HasOCamlTypeMetaData (..)++  ) where++-- base+import Data.Monoid ((<>))+import Data.Proxy (Proxy (..))+import Data.Typeable (typeRep, Typeable, typeRepTyCon, tyConName, tyConModule, tyConPackage)+import GHC.TypeLits++-- containers+import qualified Data.Map.Strict as Map++-- directory+import System.Directory (createDirectoryIfMissing)++-- filepath+import System.FilePath.Posix ((</>), (<.>))++-- ocaml-export+import OCaml.Internal.Common hiding ((</>))+import OCaml.BuckleScript.Internal.Module+import OCaml.BuckleScript.Types++-- servant+import Servant.API ((:>), (:<|>))++-- text+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T++-- typelits-witnesses+import GHC.TypeLits.List++++-- ==============================================+-- Types+-- ==============================================++data OCamlPackage (packageName :: Symbol) (packageDependencies :: [*])+  deriving Typeable++type NoDependency = '[]+++++-- ==============================================+-- Data Types+-- ==============================================++-- | Options for creating an OCaml package based on Haskell types.+data PackageOptions+  = PackageOptions+    { packageRootDir :: FilePath -- ^ root directory where all relatives directories will be placed.+    , packageSrcDir :: FilePath -- ^ location to place ml and mli files relative to 'packageRootDir'.+    , packageEmbeddedFiles :: Map.Map String EmbeddedOCamlFiles+    , createInterfaceFile :: Bool -- ^ create an mli file if 'True'.+    , mSpecOptions :: Maybe SpecOptions -- ^ produce OCaml spec file if 'Just'.+    }++-- | Default 'PackageOptions'.+defaultPackageOptions :: PackageOptions+defaultPackageOptions = PackageOptions "ocaml-generic-package" "src" Map.empty True (Just defaultSpecOptions)++-- | Details for OCaml spec.+data SpecOptions+  = SpecOptions+    { specDir :: FilePath -- ^ Directory in which to store the OCaml spec, relative to 'packageRootDir'.+    , goldenDir :: FilePath -- ^ Location of golden JSON files produced by Haskell, relative to 'packageRootDir'.+    , servantURL :: String -- ^ The URL of the automated Servant spec server to run OCaml specs against.+    }++-- | Default 'SpecOptions'.+defaultSpecOptions :: SpecOptions+defaultSpecOptions = SpecOptions "/__tests__" "/__tests__/golden" "localhost:8081"+++-- ==============================================+-- Type Level Functions+-- ==============================================++-- | Iterate over a list of OCamlModule types that are concated with '(:<|>)',+--   to create a package.+class HasOCamlPackage a where+  mkPackage :: Proxy a -> PackageOptions -> IO ()++instance (HasOCamlTypeMetaData deps, HasOCamlTypeMetaData a, HasOCamlPackage' a) => HasOCamlPackage (OCamlPackage packageName deps :> a) where+  mkPackage Proxy packageOptions = mkPackage' (Proxy :: Proxy a) packageOptions (mkOCamlTypeMetaData (Proxy :: Proxy deps) <> mkOCamlTypeMetaData (Proxy :: Proxy a))++instance {-# OVERLAPPABLE #-} (HasOCamlTypeMetaData a, HasOCamlPackage' a) => HasOCamlPackage a where+  mkPackage Proxy packageOptions = do+    mkPackage' (Proxy :: Proxy a) packageOptions (mkOCamlTypeMetaData (Proxy :: Proxy a))++class HasOCamlPackage' a where+  mkPackage' :: Proxy a -> PackageOptions -> Map.Map HaskellTypeMetaData OCamlTypeMetaData -> IO ()++instance (HasOCamlPackage' modul, HasOCamlPackage' rest) => HasOCamlPackage' (modul :<|> rest) where+  mkPackage' Proxy packageOptions deps = do+    mkPackage' (Proxy :: Proxy modul) packageOptions deps+    mkPackage' (Proxy :: Proxy rest) packageOptions deps++instance {-# OVERLAPPABLE #-} (HasOCamlModule a) => HasOCamlPackage' a where+  mkPackage' Proxy packageOptions = mkModule (Proxy :: Proxy a) packageOptions++++++-- | Depending on 'PackageOptions' settings, 'mkModule' can+--   - make a declaration file containing encoders and decoders+--   - make an OCaml interface file+--   - make a Spec file that tests the encoders and decoders against a golden file and a servant server+class HasOCamlModule a where+  mkModule :: Proxy a -> PackageOptions -> Map.Map HaskellTypeMetaData OCamlTypeMetaData -> IO ()++instance (KnownSymbols modules, HasOCamlModule' api) => HasOCamlModule ((OCamlModule modules) :> api) where+  mkModule Proxy packageOptions deps = mkModule' (Proxy :: Proxy api) (symbolsVal (Proxy :: Proxy modules)) packageOptions deps++class HasOCamlModule' a where+  mkModule' :: Proxy a -> [String] -> PackageOptions -> Map.Map HaskellTypeMetaData OCamlTypeMetaData -> IO ()++instance (HasOCamlType api) => HasOCamlModule' api where+  mkModule' Proxy modules packageOptions ds = do+    if (length modules) == 0+      then fail "OCamlModule filePath needs at least one file name"+      else do+        createDirectoryIfMissing True (rootDir </> packageSrcDir packageOptions)+        let typF = (<> "\n") . T.intercalate "\n\n" $ mkType (Proxy :: Proxy api) (defaultOptions {dependencies = ds}) (createInterfaceFile packageOptions) (packageEmbeddedFiles packageOptions)+        T.writeFile (fp <.> "ml")  typF++        if createInterfaceFile packageOptions+        then do+          let intF = (<> "\n") . T.intercalate "\n\n" $ mkInterface (Proxy :: Proxy api) (defaultOptions {dependencies = ds}) (packageEmbeddedFiles packageOptions)+          T.writeFile (fp <.> "mli") intF+        else pure ()+        +        case mSpecOptions packageOptions of+          Nothing -> pure ()+          Just specOptions -> do+            let specF = (<> "\n") . T.intercalate "\n\n" $ mkSpec (Proxy :: Proxy api) (defaultOptions {dependencies = ds}) moduls (T.pack $ servantURL specOptions) (T.pack $ goldenDir specOptions) (packageEmbeddedFiles packageOptions)+            let specBody = if specF /= "" then ("let () =\n" <> specF) else ""+            createDirectoryIfMissing True (rootDir </> (specDir specOptions))+            T.writeFile (specFp <> "_spec" <.> "ml") specBody+    +            where+              specFp = rootDir </> (specDir specOptions) </> (foldl (</>) "" modules)+              moduls = T.pack <$> modules+    where+      rootDir = packageRootDir packageOptions+      fp = rootDir </> (packageSrcDir packageOptions) </> (foldl (</>) "" modules)++++++-- | Produce type meta data for an OCamlPackage and its dependencies+class HasOCamlTypeMetaData a where+  mkOCamlTypeMetaData :: Proxy a -> Map.Map HaskellTypeMetaData OCamlTypeMetaData++-- | packages+instance (HasOCamlTypeMetaData (OCamlPackage packageName deps), HasOCamlTypeMetaData rest) => HasOCamlTypeMetaData (OCamlPackage packageName deps :<|> rest) where+  mkOCamlTypeMetaData Proxy = mkOCamlTypeMetaData (Proxy :: Proxy (OCamlPackage packageName deps)) <> mkOCamlTypeMetaData (Proxy :: Proxy rest)++-- | build a packages dependencies and its declared modules+instance (HasOCamlTypeMetaData deps, HasOCamlTypeMetaData modules) => HasOCamlTypeMetaData (OCamlPackage packageName deps :> modules) where+  mkOCamlTypeMetaData Proxy = mkOCamlTypeMetaData (Proxy :: Proxy deps) <> mkOCamlTypeMetaData (Proxy :: Proxy modules)++-- | packages+instance (HasOCamlTypeMetaData modul, HasOCamlTypeMetaData rst) => HasOCamlTypeMetaData (modul ': rst) where+  mkOCamlTypeMetaData Proxy = mkOCamlTypeMetaData (Proxy :: Proxy modul) <> mkOCamlTypeMetaData (Proxy :: Proxy rst)++-- | modules+instance (HasOCamlTypeMetaData modul, HasOCamlTypeMetaData rst) => HasOCamlTypeMetaData (modul :<|> rst) where+  mkOCamlTypeMetaData Proxy = mkOCamlTypeMetaData (Proxy :: Proxy modul) <> mkOCamlTypeMetaData (Proxy :: Proxy rst)++-- | single module+instance (KnownSymbols modules, HasOCamlTypeMetaData' api) => HasOCamlTypeMetaData ((OCamlModule modules) :> api) where+  mkOCamlTypeMetaData Proxy = Map.fromList $ mkOCamlTypeMetaData' (T.pack <$> symbolsVal (Proxy :: Proxy modules)) [] (Proxy :: Proxy api)++-- | empty list+instance HasOCamlTypeMetaData '[] where+  mkOCamlTypeMetaData Proxy = Map.empty++-- | Need flag to overcome overlapping issues+type family (HasOCamlTypeMetaDataFlag a) :: Nat where+  HasOCamlTypeMetaDataFlag (OCamlSubModule a :> b) = 4+  HasOCamlTypeMetaDataFlag (a :> b) = 3+  HasOCamlTypeMetaDataFlag (OCamlTypeInFile a b) = 2+  HasOCamlTypeMetaDataFlag a = 1++class HasOCamlTypeMetaData' a where+  mkOCamlTypeMetaData' :: [Text] -> [Text] -> Proxy a -> [(HaskellTypeMetaData,OCamlTypeMetaData)]++instance (HasOCamlTypeMetaDataFlag a ~ flag, HasOCamlTypeMetaData'' flag (a :: *)) => HasOCamlTypeMetaData' a where+  mkOCamlTypeMetaData' = mkOCamlTypeMetaData'' (Proxy :: Proxy flag)++class HasOCamlTypeMetaData'' (flag :: Nat) a where+  mkOCamlTypeMetaData'' :: Proxy flag -> [Text] -> [Text] -> Proxy a -> [(HaskellTypeMetaData,OCamlTypeMetaData)]++instance (KnownSymbol subModule, HasOCamlTypeMetaData' b) => HasOCamlTypeMetaData'' 4 (OCamlSubModule subModule :> b) where+  mkOCamlTypeMetaData'' _ modules subModules Proxy =+    (mkOCamlTypeMetaData' modules (subModules ++ [T.pack $ symbolVal (Proxy :: Proxy subModule)]) (Proxy :: Proxy b))++instance (HasOCamlTypeMetaData' a, HasOCamlTypeMetaData' b) => HasOCamlTypeMetaData'' 3 (a :> b) where+  mkOCamlTypeMetaData'' _ modul subModul Proxy = (mkOCamlTypeMetaData' modul subModul (Proxy :: Proxy a)) <> (mkOCamlTypeMetaData' modul subModul (Proxy :: Proxy b))+++instance (Typeable a) => HasOCamlTypeMetaData'' 2 (OCamlTypeInFile a b) where+  mkOCamlTypeMetaData'' _ modul subModul Proxy =+    [( HaskellTypeMetaData typeName (T.pack . tyConModule . typeRepTyCon $ aTypeRep) (T.pack . tyConPackage . typeRepTyCon $ aTypeRep)+    ,  OCamlTypeMetaData typeName modul subModul+    )]+    where+      aTypeRep = typeRep (Proxy :: Proxy a)+      typeName = T.pack . tyConName . typeRepTyCon $ aTypeRep++instance (Typeable a) => HasOCamlTypeMetaData'' 1 a where+  mkOCamlTypeMetaData'' _ modul subModul Proxy =+    [( HaskellTypeMetaData typeName (T.pack . tyConModule . typeRepTyCon $ aTypeRep) (T.pack . tyConPackage . typeRepTyCon $ aTypeRep)+    ,  OCamlTypeMetaData typeName modul subModul+    )]+    where+      aTypeRep = typeRep (Proxy :: Proxy a)+      typeName = T.pack . tyConName . typeRepTyCon $ aTypeRep

@@ -0,0 +1,245 @@+{-|+Module      : OCaml.BuckleScript.Internal.Spec+Description : Build OCaml Modules from Haskell Types+Copyright   : Plow Technologies, 2017+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : experimental++-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE DeriveFoldable     #-}+{-# LANGUAGE DeriveTraversable  #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE KindSignatures  #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds  #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++module OCaml.BuckleScript.Internal.Spec+  (+    mkOCamlSpecServer+  , MkOCamlSpecAPI++  , mkGoldenFiles++  -- utility functions+  , OCamlSpecAPI+  , OCamlPackageTypeCount (..)+  , OCamlModuleTypeCount (..)+  ) where++-- base+import Data.Proxy+import Data.Semigroup (Semigroup (..))+import GHC.Generics+import GHC.TypeLits++-- aeson+import Data.Aeson (ToJSON)++-- hspec-aeson-golden+import Test.Aeson.Internal.ADT.GoldenSpecs (mkGoldenFileForType)++-- ocaml-export+import OCaml.Internal.Common hiding ((</>))+import OCaml.BuckleScript.Internal.Module+import OCaml.BuckleScript.Internal.Package++-- quickcheck-arbitrary-adt+import Test.QuickCheck.Arbitrary.ADT++-- servant+import Servant.API++-- template-haskell+import Language.Haskell.TH++-- text+import Data.Text (Text)+++mkOCamlSpecServer :: forall ocamlPackage. (OCamlPackageTypeCount ocamlPackage) => String -> Proxy ocamlPackage -> Q [Dec]+mkOCamlSpecServer typeName Proxy = do+  let sizes = ocamlPackageTypeCount (Proxy :: Proxy ocamlPackage)+  if (length sizes) < 1 || (not . and $ (> 0) <$> sizes)+    then fail $ "sizes must have at least one element and each element must be greater than zero: " <> show sizes+    else do+      let argss = (\size -> foldr (\l r -> ParensE $ UInfixE l (ConE $ mkName ":<|>") r) (VarE $ mkName "pure") (replicate (size-1) (VarE $ mkName "pure"))) <$> sizes+      let args = foldl (\l r -> UInfixE l (ConE $ mkName ":<|>") r) (head argss) (tail argss)+      return $+        [ SigD serverName (AppT (ConT $ mkName "Server") $ AppT (ConT $ mkName "MkOCamlSpecAPI") (ConT $ apiName))+        , FunD serverName [Clause [] (NormalB args ) [] ]++        , SigD apiProxy (AppT (ConT $ mkName "Proxy") $ AppT (ConT $ mkName "MkOCamlSpecAPI") (ConT $ apiName))+        , FunD apiProxy [Clause [] (NormalB $ ConE $ mkName "Proxy") []]++        , SigD appName (ConT $ mkName "Application")+        , FunD appName [Clause [] (NormalB $ AppE (AppE (VarE $ mkName "serve") (VarE apiProxy)) (VarE serverName)) []]+        ]+   where+     serverName = mkName $ lowercaseFirst typeName ++ "Server"+     apiName = mkName $ uppercaseFirst typeName+     apiProxy = mkName $ lowercaseFirst typeName ++ "API"+     appName = mkName $ lowercaseFirst typeName ++ "App"+++-- | Make hspec-aeson-golden golden files for each type in an OCamlPackage+class HasMkGoldenFiles a where+  mkGoldenFiles :: Proxy a -> Int -> FilePath -> IO ()++instance (HasMkGoldenFilesFlag a ~ flag, HasMkGoldenFiles' flag (a :: *)) => HasMkGoldenFiles a where+  mkGoldenFiles = mkGoldenFiles' (Proxy :: Proxy flag)++type family (HasMkGoldenFilesFlag a) :: Nat where+  HasMkGoldenFilesFlag (OCamlPackage a b :> c) = 7+  HasMkGoldenFilesFlag ((OCamlModule a :> b) :<|> c) = 6+  HasMkGoldenFilesFlag (OCamlModule a :> b) = 5+  HasMkGoldenFilesFlag (OCamlSubModule a :> b) = 4+  HasMkGoldenFilesFlag (OCamlTypeInFile a b) = 3+  HasMkGoldenFilesFlag (a :> b) = 2+  HasMkGoldenFilesFlag a = 1++class HasMkGoldenFiles' (flag :: Nat) a where+  mkGoldenFiles' :: Proxy flag -> Proxy a -> Int -> FilePath -> IO ()++instance (HasMkGoldenFiles a) => HasMkGoldenFiles' 7 (OCamlPackage packageName deps :> a) where+  mkGoldenFiles' _ Proxy size fp = mkGoldenFiles (Proxy :: Proxy a) size fp++instance (HasMkGoldenFiles a, HasMkGoldenFiles b) => HasMkGoldenFiles' 6 ((OCamlModule modules :> a) :<|> b) where+  mkGoldenFiles' _ Proxy size fp = do+    mkGoldenFiles (Proxy :: Proxy a) size fp+    mkGoldenFiles (Proxy :: Proxy b) size fp+    +instance (HasMkGoldenFiles a) => HasMkGoldenFiles' 5 (OCamlModule modules :> a) where+  mkGoldenFiles' _ Proxy size fp = mkGoldenFiles (Proxy :: Proxy a) size fp++instance (HasMkGoldenFiles a) => HasMkGoldenFiles' 4 (OCamlSubModule subModule :> a) where+  mkGoldenFiles' _ Proxy size fp = mkGoldenFiles (Proxy :: Proxy a) size fp++instance (ToADTArbitrary a, ToJSON a) => HasMkGoldenFiles' 3 (OCamlTypeInFile a b) where+  mkGoldenFiles' _ Proxy size fp = mkGoldenFileForType size (Proxy :: Proxy a) fp++instance (HasMkGoldenFiles a, HasMkGoldenFiles b) => HasMkGoldenFiles' 2 (a :> b) where+  mkGoldenFiles' _ Proxy size fp = do+    mkGoldenFiles (Proxy :: Proxy a) size fp+    mkGoldenFiles (Proxy :: Proxy b) size fp++instance (ToADTArbitrary a, ToJSON a) => HasMkGoldenFiles' 1 a where+  mkGoldenFiles' _ Proxy size fp = mkGoldenFileForType size (Proxy :: Proxy a) fp++++++-- | Convert an OCamlPackage into a servant API.+type family MkOCamlSpecAPI a :: * where+  MkOCamlSpecAPI (OCamlPackage a deps :> rest) = MkOCamlSpecAPI rest  +  MkOCamlSpecAPI ((OCamlModule modules :> api) :<|> rest) = MkOCamlSpecAPI' modules '[] api :<|> MkOCamlSpecAPI rest+  MkOCamlSpecAPI (OCamlModule modules :> api) = MkOCamlSpecAPI' modules '[] api++-- | Utility type level function.+type family MkOCamlSpecAPI' modules subModules api :: * where+  MkOCamlSpecAPI' modules subModules ((OCamlSubModule restSubModules) :> a) = MkOCamlSpecAPI' modules (Append subModules '[restSubModules]) a+  MkOCamlSpecAPI' modules subModules (a :> b) = MkOCamlSpecAPI' modules subModules a :<|> MkOCamlSpecAPI' modules subModules b+  MkOCamlSpecAPI' modules subModules (OCamlTypeInFile api _typeFilePath) = OCamlSpecAPI modules subModules api+  MkOCamlSpecAPI' modules subModules api = OCamlSpecAPI modules subModules api++-- | A servant route for a testing an OCaml type's encoder and decoder+type OCamlSpecAPI (modules :: [Symbol]) (subModules :: [Symbol]) typ =+  ConcatSymbols (Insert (TypeName typ) (Append modules subModules)) (ReqBody '[JSON] [typ] :> Post '[JSON] [typ])++class OCamlModuleTypeCount api where+  ocamlModuleTypeCount :: Proxy api -> Int+    +instance (OCamlModuleTypeCountFlag a ~ flag, OCamlModuleTypeCount' flag (a :: *)) => OCamlModuleTypeCount a where+  ocamlModuleTypeCount = ocamlModuleTypeCount' (Proxy :: Proxy flag)++type family (OCamlModuleTypeCountFlag a) :: Bool where+  OCamlModuleTypeCountFlag (a :> b)           = 'True+  OCamlModuleTypeCountFlag (OCamlModule a)    = 'True+  OCamlModuleTypeCountFlag (OCamlSubModule a) = 'True+  OCamlModuleTypeCountFlag a                  = 'False++class OCamlModuleTypeCount' (flag :: Bool) a where+  ocamlModuleTypeCount' :: Proxy flag -> Proxy a -> Int++instance (OCamlModuleTypeCount a, OCamlModuleTypeCount b) => OCamlModuleTypeCount' 'True (a :> b) where+  ocamlModuleTypeCount' _ Proxy = (ocamlModuleTypeCount (Proxy :: Proxy a)) + (ocamlModuleTypeCount (Proxy :: Proxy b))++instance OCamlModuleTypeCount' 'True (OCamlModule modules) where+  ocamlModuleTypeCount' _ Proxy = 0++instance OCamlModuleTypeCount' 'True (OCamlSubModule subModules) where+  ocamlModuleTypeCount' _ Proxy = 0++instance OCamlModuleTypeCount' 'False a where+  ocamlModuleTypeCount' _ Proxy = 1++class OCamlPackageTypeCount modules where                +  ocamlPackageTypeCount :: Proxy modules -> [Int]++instance (OCamlPackageTypeCountFlag a ~ flag, OCamlPackageTypeCount' flag (a :: *)) => OCamlPackageTypeCount a where+  ocamlPackageTypeCount = ocamlPackageTypeCount' (Proxy :: Proxy flag)++type family (OCamlPackageTypeCountFlag a) :: Bool where+  OCamlPackageTypeCountFlag (OCamlPackage a b :> c) = 'True+  OCamlPackageTypeCountFlag (a :<|> b)              = 'True+  OCamlPackageTypeCountFlag a                       = 'False ++class OCamlPackageTypeCount' (flag :: Bool) a where+  ocamlPackageTypeCount' :: Proxy flag -> Proxy a -> [Int]++-- OCamlPackage does not increment+instance (OCamlPackageTypeCount b) => OCamlPackageTypeCount' 'True (OCamlPackage a deps :> b) where+  ocamlPackageTypeCount' _ Proxy = ocamlPackageTypeCount (Proxy :: Proxy b)++-- Choice operator does not increment+instance (OCamlModuleTypeCount a, OCamlPackageTypeCount b) => OCamlPackageTypeCount' 'True (a :<|> b) where+  ocamlPackageTypeCount' _ Proxy = (ocamlModuleTypeCount (Proxy :: Proxy a)) : (ocamlPackageTypeCount (Proxy :: Proxy b))++-- everything else should count as one+instance (OCamlModuleTypeCount a) => OCamlPackageTypeCount' 'False a where+  ocamlPackageTypeCount' _ Proxy = [ocamlModuleTypeCount (Proxy :: Proxy a)]+++-- | Convert a type into a Symbol at the type level.+type family TypeName a :: Symbol where+  -- Types which don't have a Generic instance+  TypeName Double = "Double"+  TypeName Int    = "Int"+  TypeName String = "String"+  TypeName Text   = "Text"++  -- Generic instances+  TypeName (M1 D ('MetaData name _ _ _) f ()) = name+  TypeName a = TypeName (Rep a ())++-- | Append two type level lists.+type family Append xy ys where+  Append '[] ys = ys+  Append (x ': xs) ys = x ': (Append xs ys)++-- | Get the length of a type level list.+type family Length xs :: Nat where+  Length '[]       = 0+  Length (x ': xs) = 1 + Length xs++-- | Insert type into type level list+type family Insert a xs where+  Insert a '[]       = a ': '[]+  Insert a (x ': xs) = x ': (Insert a xs)++-- | Concat a Symbol the end of a list of Symbols.+type family ConcatSymbols xs rhs :: * where+  ConcatSymbols '[] rhs = rhs+  ConcatSymbols (x ': xs) rhs = x :> ConcatSymbols xs rhs

@@ -0,0 +1,255 @@+{-|+Module      : OCaml.BuckleScript.Record+Description : Create OCaml data types from Haskell data types+Copyright   : Plow Technologies, 2017+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : experimental++For a Haskell type with an instance of OCamlType, output the+OCaml type declaration.+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module OCaml.BuckleScript.Record+  ( toOCamlTypeSourceWith+  ) where++-- base+import Control.Monad.Reader+import Data.List (nub)+import Data.Maybe (catMaybes)+import Data.Monoid+import Data.Proxy (Proxy (..))++-- containers+import qualified Data.Map.Strict as Map++-- ocaml-export+import OCaml.BuckleScript.Types+import OCaml.Internal.Common++-- text+import Data.Text (Text)+import qualified Data.Text as T++-- wl-pprint+import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>))++-- | render a Haskell data type in OCaml+class HasType a where+  render :: a -> Reader TypeMetaData Doc++class HasRecordType a where+  renderRecord :: a -> Reader TypeMetaData Doc++class HasTypeRef a where+  renderRef :: a -> Reader TypeMetaData Doc++instance HasType OCamlDatatype where+  render datatype@(OCamlDatatype _mOCamlTypeDataType typeName constructor@(OCamlSumOfRecordConstructor _ (MultipleConstructors constructors))) = do+    -- For each constructor, if it is a record constructor, declare a type for that record+    -- before and separate form the main sum type.+    sumRecordsData <- catMaybes <$> sequence (renderSumRecord typeName <$> constructors)+    let sumRecords = msuffix (line <> line) (fst <$> sumRecordsData)+        newConstructors = replaceRecordConstructors (snd <$> sumRecordsData) <$> constructors+        typeParameters = renderTypeParameters constructor+    fnName <- renderRef datatype+    fnBody <- render (OCamlValueConstructor $ MultipleConstructors newConstructors)+    pure $ sumRecords <> ("type" <+> typeParameters <+> fnName <+> "=" <$$> indent 2 ("|" <+> fnBody))++  render datatype@(OCamlDatatype _ _ constructor@(OCamlValueConstructor (RecordConstructor _ _))) = do+    let typeParameters = renderTypeParameters constructor+    fnName <- renderRef datatype+    fnBody <- render constructor+    pure $ "type" <+> typeParameters <+> fnName <+> "=" <$$> indent 2 fnBody++  render datatype@(OCamlDatatype _ _ constructor) = do+    let typeParameters = renderTypeParameters constructor+    fnName <- renderRef datatype+    fnBody <- render constructor+    pure $ "type" <+> typeParameters <+> fnName <+> "=" <$$> indent 2 ("|" <+> fnBody)++  render (OCamlPrimitive primitive) = renderRef primitive++instance HasTypeRef OCamlDatatype where+  renderRef datatype@(OCamlDatatype typeRef typeName _) = do+    if isTypeParameterRef datatype+    then+      pure . stext $ "'" <> textLowercaseFirst typeName+    else do+      mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData +      case mOCamlTypeMetaData of+        Nothing -> pure . stext . textLowercaseFirst $ typeName++        Just decOCamlTypeMetaData -> do+          ds <- asks (dependencies . userOptions)+          case Map.lookup typeRef ds of+            Just parOCamlTypeMetaData -> do+              let prefix = stext $ mkModulePrefix decOCamlTypeMetaData parOCamlTypeMetaData+              pure $ prefix <> (stext . textLowercaseFirst $ typeName)+            Nothing -> fail ("expected to find dependency:\n\n" ++ show typeRef ++ "\n\nin\n\n" ++ show ds)++  renderRef (OCamlPrimitive primitive) = renderRef primitive++instance HasType OCamlConstructor where+  render (OCamlValueConstructor value) = render value+  render (OCamlSumOfRecordConstructor _ value) = render value+  render (OCamlEnumeratorConstructor constructors) = do+    mintercalate (line <> "|" <> space) <$> sequence (render <$> constructors)++instance HasType ValueConstructor where+  -- record+  render (RecordConstructor _ value) = do+    fields <- renderRecord value+    pure $ "{" <+> fields <$$> "}"++  -- enumerator+  render (NamedConstructor constructorName (OCamlEmpty)) = do+    pure $ stext constructorName++  -- product+  render (NamedConstructor constructorName value) = do+    types <- render value+    pure $ stext constructorName <+> "of" <+> types++  -- sum+  render (MultipleConstructors constructors) = do+    mintercalate (line <> "|" <> space) <$> sequence (render <$> constructors)++instance HasType EnumeratorConstructor where+  render (EnumeratorConstructor name) = pure (stext name)++instance HasType OCamlValue where+  render ref@(OCamlRef typeRef name) = do+    mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData+    case mOCamlTypeMetaData of+      Nothing -> fail $ "OCaml.BuckleScript.Record (HasType (OCamlDatatype typeRep name)) mOCamlTypeMetaData is Nothing:\n\n" ++ (show ref)+      Just decOCamlTypeMetaData -> do+        ds <- asks (dependencies . userOptions)+        case Map.lookup typeRef ds of+          Just parOCamlTypeMetaData -> do+            let prefix = stext $ mkModulePrefix decOCamlTypeMetaData parOCamlTypeMetaData+            pure $ prefix <> (stext . textLowercaseFirst $ name)+          -- in case of a Haskell sum of products, ocaml-export creates a definition for each product+          -- within the same file as the sum. These products will not be in the dependencies map.+          Nothing -> pure . stext . textLowercaseFirst $ name++  render (OCamlTypeParameterRef name) = pure (stext ("'" <> name))+  render (OCamlPrimitiveRef primitive) = ocamlRefParens primitive <$> renderRef primitive+  render OCamlEmpty = pure (text "")+  render (Values x y) = do+    dx <- render x+    dy <- render y+    return $ dx <+> "*" <+> dy+  render (OCamlField name value) = do+    dv <- renderRecord value+    return $ stext name <+> ":" <+> dv++instance HasRecordType OCamlValue where+  renderRecord (OCamlPrimitiveRef primitive) = renderRef primitive+  renderRecord (Values x y) = do+    dx <- renderRecord x+    dy <- renderRecord y+    return $ dx <$$> ";" <+> dy+  renderRecord value = render value++instance HasTypeRef OCamlPrimitive where+  renderRef (OList (OCamlPrimitive OChar)) = renderRef OString+  renderRef (OList datatype) = do+    dt <- renderRef datatype+    return $ parens dt <+> "list"+  renderRef (OTuple2 a b) = do+    da <- renderRef a+    db <- renderRef b+    return . parens $ da <+> "*" <+> db+  renderRef (OTuple3 a b c) = do+    da <- renderRef a+    db <- renderRef b+    dc <- renderRef c+    return . parens $ da <+> "*" <+> db <+> "*" <+> dc+  renderRef (OTuple4 a b c d) = do+    da <- renderRef a+    db <- renderRef b+    dc <- renderRef c+    dd <- renderRef d+    return . parens $ da <+> "*" <+> db <+> "*" <+> dc <+> "*" <+> dd+  renderRef (OTuple5 a b c d e) = do+    da <- renderRef a+    db <- renderRef b+    dc <- renderRef c+    dd <- renderRef d+    de <- renderRef e+    return . parens $ da <+> "*" <+> db <+> "*" <+> dc <+> "*" <+> dd <+> "*" <+> de+  renderRef (OTuple6 a b c d e f) = do+    da <- renderRef a+    db <- renderRef b+    dc <- renderRef c+    dd <- renderRef d+    de <- renderRef e+    df <- renderRef f+    return . parens $ da <+> "*" <+> db <+> "*" <+> dc <+> "*" <+> dd <+> "*" <+> de <+> "*" <+> df+  renderRef (OOption datatype) = do+    dt <- renderRef datatype+    return $ parens dt <+> "option"+  renderRef (OEither k v) = do+    dk <- renderRef k+    dv <- renderRef v+    return $ (parens $ dk <> "," <+> dv) <+> "Aeson.Compatibility.Either.t"+  renderRef OInt    = pure "int"+  renderRef ODate   = pure "Js_date.t"+  renderRef OBool   = pure "bool"+  renderRef OChar   = pure "string"+  renderRef OString = pure "string"+  renderRef OUnit   = pure "unit"+  renderRef OFloat  = pure "float"++-- Util functions++-- | A Haskell Sum of Records needs to be transformed into OCaml record types+--   and a sum type. Replace RecordConstructor with NamedConstructor.+replaceRecordConstructors :: [(Text,ValueConstructor)] -> ValueConstructor -> ValueConstructor+replaceRecordConstructors newConstructors recordConstructor@(RecordConstructor oldName _) = +  case length newRecordConstructor > 0 of+    False -> recordConstructor+    True  -> head newRecordConstructor+  where+    replace (oldName', (RecordConstructor newName _value)) =+      if oldName == oldName' then (Just $ NamedConstructor oldName' (OCamlRef (HaskellTypeMetaData "" "" "") newName)) else Nothing+    replace _ = Nothing+    newRecordConstructor = catMaybes $ replace <$> newConstructors++replaceRecordConstructors _ rc = rc++-- | Given a constructor, output a list of type parameters.+--   (Maybe a) -> 'a0 list -> ["'a0"]+--   (Either a b) -> 'a0 'a1 list -> ["'a0","'a1"]+renderTypeParameters :: OCamlConstructor -> Doc+renderTypeParameters constructor = mkDocList $ stext . (<>) "'" <$> (nub $ getTypeParameters constructor)++-- | For Haskell Sum of Records, create OCaml record types of each RecordConstructor+renderSumRecord :: Text -> ValueConstructor -> Reader TypeMetaData (Maybe (Doc,(Text,ValueConstructor)))+renderSumRecord typeName constructor@(RecordConstructor name value) = do+  let sumRecordName = typeName <> name+  functionBody <- render constructor+  pure $ Just (("type" <+> (stext (textLowercaseFirst sumRecordName)) <+> "=" <$$> indent 2 functionBody), (name, (RecordConstructor sumRecordName value)))+renderSumRecord _ _ = return Nothing++-- | Puts parentheses around the doc of an OCaml ref if it contains spaces.+ocamlRefParens :: OCamlPrimitive -> Doc -> Doc+ocamlRefParens (OList (OCamlPrimitive OChar)) = id+ocamlRefParens (OList _) = parens+ocamlRefParens (OOption _) = parens+ocamlRefParens _ = id++-- | Convert a 'Proxy a' into OCaml type source code.+toOCamlTypeSourceWith :: forall a. OCamlType a => Options -> a -> T.Text+toOCamlTypeSourceWith options a =+  case toOCamlType (Proxy :: Proxy a) of+    OCamlDatatype haskellTypeMetaData _ _ ->+      case Map.lookup haskellTypeMetaData (dependencies options) of+        Just ocamlTypeMetaData -> pprinter $ runReader (render (toOCamlType a)) (TypeMetaData (Just ocamlTypeMetaData) options)+        Nothing -> ""+    _ -> pprinter $ runReader (render (toOCamlType a)) (TypeMetaData Nothing options)

@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module OCaml.BuckleScript.Spec+  ( mkSampleServerAndGoldenSpec+  , toOCamlSpec+  , typeInFileToOCamlSpec+  ) where++-- base+import Data.Monoid+-- text+import Data.Text (Text)+import qualified Data.Text as T+-- ocaml-export+import OCaml.BuckleScript.Types hiding (getOCamlValues)+import OCaml.Internal.Common+-- wl-pprint+import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>), (</>))++mkSampleServerAndGoldenSpec :: OCamlDatatype -> Maybe Int -> [Text] -> Text -> Text -> Doc+mkSampleServerAndGoldenSpec (OCamlDatatype _ typeName constructors) mParameterRefCount modules url goldenDir =+  indent 2 $+    "AesonSpec.sampleGoldenAndServerSpec" <$$> (indent 2 $+          decoders+      <$$> encoders+      <$$> (dquotes down)+      <$$> (dquotes . stext $ ((url </> urlModul) </> typeName))+      <$$> (dquotes (stext $ goldenDir </> textUppercaseFirst typeName)) <> ";")+  where+    (tprDecoders, tprEncoders) = renderTypeParameterVals mParameterRefCount constructors+    decoders = if tprDecoders == "" then (smodul <> "decode" <> up) else ("(" <> smodul <> "decode" <> up <+> (stext tprDecoders) <> ")")+    encoders = if tprEncoders == "" then (smodul <> "encode" <> up) else ("(" <> smodul <> "encode" <> up <+> (stext tprEncoders) <> ")")+    up = stext . textUppercaseFirst $ typeName+    down = stext . textLowercaseFirst $ typeName+    modul = T.intercalate "." (textUppercaseFirst <$> modules) :: Text+    smodul = stext $ if modul /= "" then modul <> "." else ""+    urlModul = T.intercalate "/" (textUppercaseFirst <$> modules) :: Text++mkSampleServerAndGoldenSpec (OCamlPrimitive _) _ _mod _url _fp = ""++renderTypeParameterVals :: Maybe Int -> OCamlConstructor -> (Text,Text)+renderTypeParameterVals (Just count) _ = renderTypeParameterValsAux count+renderTypeParameterVals _ (OCamlValueConstructor vc) =+  renderTypeParameterValsAux . length . getTypeParameterRefNames . getOCamlValues $ vc+renderTypeParameterVals _ (OCamlSumOfRecordConstructor _ vc) =+  renderTypeParameterValsAux . length . getTypeParameterRefNames . getOCamlValues $ vc+renderTypeParameterVals _ _ = ("","")++renderTypeParameterValsAux :: Int -> (Text, Text)+renderTypeParameterValsAux size =+  if size > 0+  then+    ( T.intercalate " " $ mkDecoders <$> [0..(size-1)]+    , T.intercalate " " $ mkEncoders <$> [0..(size-1)]+    )+  else+    ("","")+  where+--    size = length $ getTypeParameterRefNames ocamlValues+    mkDecoders _ = "AesonSpec.decodeIntWithResult"+    mkEncoders _ = "Aeson.Encode.int"+    -- body i = "(fun (x : Js_json.t) -> Aeson.Decode.wrapResult (Aeson.Decode.singleEnumerator Aeson.Helper.TypeParameterRef" <> (T.pack . show $ i) <> ") x)"+    -- body2 i = "(fun _x -> Aeson.Encode.singleEnumerator Aeson.Helper.TypeParameterRef" <> (T.pack . show $ i) <> ")"+    +getOCamlValues :: ValueConstructor -> [OCamlValue]+getOCamlValues (NamedConstructor     _ value) = [value]+getOCamlValues (RecordConstructor    _ value) = [value]+getOCamlValues (MultipleConstructors cs)      = concat $ getOCamlValues <$> cs++toOCamlSpec :: OCamlType a => a -> [Text] -> Text -> Text -> Text+toOCamlSpec a modules url fp =+  pprinter $ mkSampleServerAndGoldenSpec (toOCamlType a) Nothing modules url fp++-- | OCamlTypeInFile do not require an instance of OCamlType since they are+--   hand written OCaml files for Haskell types. Use typeable to get the+--   type name.+typeInFileToOCamlSpec :: Text -> Int -> [Text] -> Text -> Text -> Text+typeInFileToOCamlSpec aTyConName typeParameterRefCount modules url fp =+  pprinter $ mkSampleServerAndGoldenSpec+    (OCamlDatatype (HaskellTypeMetaData aTyConName "" "")+       aTyConName $ OCamlValueConstructor $ NamedConstructor aTyConName $ OCamlEmpty)+    (Just typeParameterRefCount)+    modules+    url+    fp++{-+toOCamlSpec2 :: Text -> [Text] -> Text -> Text -> Text+toOCamlSpec2 a modules url fp =+  pprinter $ mkSampleServerAndGoldenSpec (OCamlDatatype (HaskellTypeMetaData a "" "") a $ OCamlValueConstructor $ NamedConstructor a $ OCamlEmpty) modules url fp+-}

@@ -0,0 +1,551 @@+{-|+Module      : OCaml.BuckleScript.Types+Description : Tree representation of Haskell datatypes in OCaml+Copyright   : Plow Technologies, 2017+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : experimental++OCaml datatype representation of a Haskell datatype. A recursive tree that+can be interpreted to output OCaml code. It is meant to encode a Haskell type+into OCaml and make json seraliazers that match the output from Generic aeson+instances.+-}++{-# LANGUAGE DataKinds    #-}+{-# LANGUAGE DefaultSignatures    #-}+{-# LANGUAGE DeriveGeneric        #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE TypeSynonymInstances #-}++module OCaml.BuckleScript.Types+  ( OCamlDatatype (..)+  , OCamlPrimitive (..)+  , OCamlConstructor (..)+  , ValueConstructor (..)+  , EnumeratorConstructor (..)+  , OCamlValue (..)+  , OCamlType (..)+  , HaskellTypeMetaData (..)+  , OCamlTypeMetaData (..)+  +  -- fill type parameters of a proxy when calling toOCamlType+  -- so the kind is *+  -- e.g. `toOCamlType (Proxy :: Proxy (Either TypeParameterRef0 TypeParameterRef1))`+  , TypeParameterRef0+  , TypeParameterRef1+  , TypeParameterRef2+  , TypeParameterRef3+  , TypeParameterRef4+  , TypeParameterRef5++  -- functions for manipulating and querying the data type tree+  , getTypeParameterRefNames+  , getOCamlValues+  , getTypeParameters+  , isTypeParameterRef+  , mkModulePrefix+  ) where++-- base+import Data.Int (Int16, Int32, Int64, Int8)+import Data.List (nub)+import Data.Maybe (catMaybes)+import Data.Monoid ((<>))+import Data.Proxy+import Data.Time+import Data.Word (Word, Word8, Word16, Word32, Word64)+import GHC.Generics+import GHC.TypeLits (symbolVal, KnownSymbol)+import Prelude++-- aeson+import Data.Aeson (ToJSON, FromJSON)++-- text+import Data.Text (Text)+import qualified Data.Text as T++-- QuickCheck+import Test.QuickCheck++-- quicheck-arbitrary-adt+import Test.QuickCheck.Arbitrary.ADT++-- | Top level of an OCaml datatype. A data type may be composed of+--   primitives and/or a combination of constructors and primitives.+--   OCamlDatatype is recursive via OCamlConstructor -> ValueConstructor+--   -> OCamlValue -> OCamlPrimitive -> OCamlDatatype.+data OCamlDatatype+  = OCamlDatatype HaskellTypeMetaData Text OCamlConstructor -- ^ The name of a type and its type constructor+  | OCamlPrimitive OCamlPrimitive -- ^ A primitive value+  deriving (Show, Eq)++-- | Store data about the Haskell origin of a type.+data HaskellTypeMetaData =+  HaskellTypeMetaData+    Text -- "TypeName"+    Text -- "Module.Name"+    Text -- "package-name"+    deriving (Show, Eq, Ord)++-- | Store data about the OCaml destination of a type.+data OCamlTypeMetaData =+  OCamlTypeMetaData+    Text -- "typeName"+    [Text] -- ["File","Path"]+    [Text] -- ["Sub","Module"]+    deriving (Show, Eq, Ord)++-- | Smallest unit of computation in OCaml.+data OCamlPrimitive+  = OInt -- ^ int+  | OBool -- ^ bool, boolean+  | OChar -- ^ char, it gets interpreted as a string because OCaml char does not support UTF-8+  | ODate -- ^ Js_date.t+  | OFloat -- ^ float+  | OString -- ^ string+  | OUnit -- ^ ()+  | OList OCamlDatatype -- ^ 'a list, 'a Js_array.t+  | OOption OCamlDatatype -- ^ 'a option+  | OEither OCamlDatatype OCamlDatatype -- ^ 'l 'r Aeson.Compatibility.Either.t+  | OTuple2 OCamlDatatype OCamlDatatype -- ^ (*)+  | OTuple3 OCamlDatatype OCamlDatatype OCamlDatatype -- ^ (**)+  | OTuple4 OCamlDatatype OCamlDatatype OCamlDatatype OCamlDatatype -- ^ (***)+  | OTuple5 OCamlDatatype OCamlDatatype OCamlDatatype OCamlDatatype OCamlDatatype -- ^ (****)+  | OTuple6 OCamlDatatype OCamlDatatype OCamlDatatype OCamlDatatype OCamlDatatype OCamlDatatype -- ^ (*****)+  deriving (Show, Eq)++-- | OCamlConstructor take values to create a new instances of a type.+data OCamlConstructor +  = OCamlValueConstructor ValueConstructor -- ^ Sum, record (product with named fields) or product without named fields+  | OCamlEnumeratorConstructor [EnumeratorConstructor] -- ^ Sum of enumerations only. If a sum contains enumerators and at least one constructor with a value then it is an OCamlValueConstructor+  | OCamlSumOfRecordConstructor Text ValueConstructor -- ^ Sum that contains at least one record. This construction is unique to Haskell. pIt has special Encoding and Decoding rules in order to output a valid OCaml program. i.e. `data A = A {a :: Int} | B {b :: String}`+  deriving (Show, Eq)++-- | OCamlConstructor of one RecordConstructor is a record type.+--   OCamlConstructor of one NamedConstructor that has one value is a Haskell newtype.+--   OCamlConstructor of one NamedConstructor is a product without field names.+--   OCamlConstructor of multiple NamedConstructors is a sum type.+--   OCamlConstructor of at least one RecordConstructor and any other amount of ValueConstructors greater than one is a OCamlSumWithRecordConstructor.+data ValueConstructor+  = NamedConstructor Text OCamlValue -- ^ Product without named fields+  | RecordConstructor Text OCamlValue -- ^ Product with named fields+  | MultipleConstructors [ValueConstructor] -- ^ Sum type+  deriving (Show, Eq)++-- | Enumerators have no values, only tags.+data EnumeratorConstructor+  = EnumeratorConstructor Text -- ^ Enumerator and its tag+  deriving (Show, Eq)++-- | Expected types of a constructor+data OCamlValue+  = OCamlRef HaskellTypeMetaData Text -- ^ The name of a non-primitive data type+  | OCamlTypeParameterRef Text -- ^ Type parameters like `a` in `Maybe a`+  | OCamlEmpty -- ^ a place holder for OCaml value. It can represent the end of a list or an Enumerator in a mixed sum+  | OCamlPrimitiveRef OCamlPrimitive -- ^ A primitive OCaml type like `int`, `string`, etc.+  | OCamlField Text OCamlValue -- ^ A field name and its type from a record+  | Values OCamlValue OCamlValue -- ^ Used for multiple types in a sum type+  deriving (Show, Eq)++------------------------------------------------------------+-- | Create an OCaml type from a Haskell type. Use the Generic+--   definition when possible. It also expects `ToJSON` and `FromJSON`+--   to be derived generically.+class OCamlType a where+  toOCamlType :: a -> OCamlDatatype+  toOCamlType = genericToOCamlDatatype . from+  default toOCamlType :: (Generic a, GenericOCamlDatatype (Rep a)) =>+    a -> OCamlDatatype++------------------------------------------------------------+class GenericOCamlDatatype f where+  genericToOCamlDatatype :: f a -> OCamlDatatype++-- | Capture the Haskell type at the left side declaration `data Maybe a`, `data Person`, etc..+--   Transform the constructor, depending on its values, if necessary.+instance (KnownSymbol typ, KnownSymbol package, KnownSymbol modul, GenericValueConstructor f) => GenericOCamlDatatype (M1 D ('MetaData typ modul package 'False) f) where+  genericToOCamlDatatype datatype =+    OCamlDatatype+      (HaskellTypeMetaData+       (T.pack $ symbolVal (Proxy :: Proxy typ))+       (T.pack $ symbolVal (Proxy :: Proxy modul))+       (T.pack $ symbolVal (Proxy :: Proxy package)))+      (T.pack (datatypeName datatype))+      (transform (OCamlValueConstructor (genericToValueConstructor (unM1 datatype))))+    where+      transform ocamlConstructor =+        if isEnumeration ocamlConstructor+          then transformToEnumeration ocamlConstructor+          else +            if isSumWithRecord ocamlConstructor+              then transformToSumOfRecord (T.pack (datatypeName datatype)) ocamlConstructor+              else ocamlConstructor++instance (KnownSymbol typ, KnownSymbol package, KnownSymbol modul, GenericValueConstructor f) => GenericOCamlDatatype (M1 D ('MetaData typ modul package 'True) f) where+  genericToOCamlDatatype datatype =+    OCamlDatatype+      (HaskellTypeMetaData+       (T.pack $ symbolVal (Proxy :: Proxy typ))+       (T.pack $ symbolVal (Proxy :: Proxy modul))+       (T.pack $ symbolVal (Proxy :: Proxy package)))+      (T.pack (datatypeName datatype))+      (transform (OCamlValueConstructor (genericToValueConstructor (unM1 datatype))))+    where+      transform ocamlConstructor =+        if isEnumeration ocamlConstructor+          then transformToEnumeration ocamlConstructor+          else +            if isSumWithRecord ocamlConstructor+              then transformToSumOfRecord (T.pack (datatypeName datatype)) ocamlConstructor+              else ocamlConstructor++++------------------------------------------------------------+class GenericValueConstructor f where+  genericToValueConstructor :: f a -> ValueConstructor++-- | Capture the Haskell type at the constructor. `Just` or `Nothing` from+--   `data Maybe a = Just a | Nothing`. +instance (Constructor c, GenericOCamlValue f) => GenericValueConstructor (C1 c f) where+  genericToValueConstructor constructor =+    if conIsRecord constructor+      then RecordConstructor name (genericToOCamlValue (unM1 constructor))+      else NamedConstructor name (genericToOCamlValue (unM1 constructor))+    where+      name = T.pack $ conName constructor++-- | Capture the Haskell right side at the sum partition `|`.+instance (GenericValueConstructor f, GenericValueConstructor g) =>+         GenericValueConstructor (f :+: g) where+  genericToValueConstructor _ =+    MultipleConstructors+      [ genericToValueConstructor (undefined :: f p)+      , genericToValueConstructor (undefined :: g p)+      ]++------------------------------------------------------------+class GenericOCamlValue f where+  genericToOCamlValue :: f a -> OCamlValue++-- | Capture the constructor field.+instance (Selector s, GenericOCamlValue a) =>+         GenericOCamlValue (S1 s a) where+  genericToOCamlValue selector =+    case selName selector of+      ""   -> genericToOCamlValue (undefined :: a p)+      name -> OCamlField (T.pack name) (genericToOCamlValue (undefined :: a p))++-- | Capture the product comma.+instance (GenericOCamlValue f, GenericOCamlValue g) =>+         GenericOCamlValue (f :*: g) where+  genericToOCamlValue _ =+    Values+      (genericToOCamlValue (undefined :: f p))+      (genericToOCamlValue (undefined :: g p))++-- | Enumerator, constructor with no values.+instance GenericOCamlValue U1 where+  genericToOCamlValue _ = OCamlEmpty++-- | Handle type parameter.+instance OCamlType a => GenericOCamlValue (Rec0 a) where+  genericToOCamlValue _ =+    case toOCamlType (Proxy :: Proxy a) of+      OCamlPrimitive primitive -> OCamlPrimitiveRef primitive+      OCamlDatatype haskellTypeMetaData name _ -> mkRef haskellTypeMetaData name+    where+      typeParameterRefs = (T.append) <$> ["a"] <*> (T.pack . show <$> ([0..5] :: [Int]))+      mkRef haskellTypeMetaData n+        | n `elem` typeParameterRefs = OCamlTypeParameterRef n+        | otherwise = OCamlRef haskellTypeMetaData n++-- OCamlType instances for primitives++instance OCamlType a => OCamlType [a] where+  toOCamlType _ = OCamlPrimitive (OList (toOCamlType (Proxy :: Proxy a)))++instance OCamlType a => OCamlType (Maybe a) where+  toOCamlType _ = OCamlPrimitive (OOption (toOCamlType (Proxy :: Proxy a)))++instance (OCamlType l, OCamlType r) => OCamlType (Either l r) where+  toOCamlType _ = OCamlPrimitive (OEither (toOCamlType (Proxy :: Proxy l)) (toOCamlType (Proxy :: Proxy r)))++instance OCamlType () where+  toOCamlType _ = OCamlPrimitive OUnit++instance OCamlType Text where+  toOCamlType _ = OCamlPrimitive OString++instance OCamlType Day where+  toOCamlType _ = OCamlPrimitive ODate++instance OCamlType UTCTime where+  toOCamlType _ = OCamlPrimitive ODate++instance OCamlType Float where+  toOCamlType _ = OCamlPrimitive OFloat++instance OCamlType Double where+  toOCamlType _ = OCamlPrimitive OFloat++instance OCamlType Int8 where+  toOCamlType _ = OCamlPrimitive OInt++instance OCamlType Int16 where+  toOCamlType _ = OCamlPrimitive OInt++instance OCamlType Int32 where+  toOCamlType _ = OCamlPrimitive OInt++instance OCamlType Int64 where+  toOCamlType _ = OCamlPrimitive OInt++instance OCamlType Word where+  toOCamlType _ = OCamlPrimitive OInt++instance OCamlType Word8 where+  toOCamlType _ = OCamlPrimitive OInt++instance OCamlType Word16 where+  toOCamlType _ = OCamlPrimitive OInt++instance OCamlType Word32 where+  toOCamlType _ = OCamlPrimitive OInt++instance OCamlType Word64 where+  toOCamlType _ = OCamlPrimitive OInt++instance OCamlType Int where+  toOCamlType _ = OCamlPrimitive OInt++instance OCamlType Integer where+  toOCamlType _ = OCamlPrimitive OInt++instance OCamlType Char where+  toOCamlType _ = OCamlPrimitive OChar++instance OCamlType Bool where+  toOCamlType _ = OCamlPrimitive OBool++instance (OCamlType a, OCamlType b) => OCamlType (a, b) where+  toOCamlType _ =+    OCamlPrimitive $+    OTuple2 (toOCamlType (Proxy :: Proxy a)) (toOCamlType (Proxy :: Proxy b))++instance (OCamlType a, OCamlType b, OCamlType c) => OCamlType (a, b, c) where+  toOCamlType _ =+    OCamlPrimitive $+    OTuple3 (toOCamlType (Proxy :: Proxy a)) (toOCamlType (Proxy :: Proxy b))+            (toOCamlType (Proxy :: Proxy c))++instance (OCamlType a, OCamlType b, OCamlType c, OCamlType d) => OCamlType (a, b, c, d) where+  toOCamlType _ =+    OCamlPrimitive $+    OTuple4 (toOCamlType (Proxy :: Proxy a)) (toOCamlType (Proxy :: Proxy b))+            (toOCamlType (Proxy :: Proxy c)) (toOCamlType (Proxy :: Proxy d))++instance (OCamlType a, OCamlType b, OCamlType c, OCamlType d, OCamlType e) => OCamlType (a, b, c, d, e) where+  toOCamlType _ =+    OCamlPrimitive $+    OTuple5 (toOCamlType (Proxy :: Proxy a)) (toOCamlType (Proxy :: Proxy b))+            (toOCamlType (Proxy :: Proxy c)) (toOCamlType (Proxy :: Proxy d))+            (toOCamlType (Proxy :: Proxy e))++instance (OCamlType a, OCamlType b, OCamlType c, OCamlType d, OCamlType e, OCamlType f) => OCamlType (a, b, c, d, e, f) where+  toOCamlType _ =+    OCamlPrimitive $+    OTuple6 (toOCamlType (Proxy :: Proxy a)) (toOCamlType (Proxy :: Proxy b))+            (toOCamlType (Proxy :: Proxy c)) (toOCamlType (Proxy :: Proxy d))+            (toOCamlType (Proxy :: Proxy e)) (toOCamlType (Proxy :: Proxy f))+++instance (OCamlType a) =>+         OCamlType (Proxy a) where+  toOCamlType _ = toOCamlType (undefined :: a)++{-+-- ToJSON and FromJSON instances are provided for the following types in aeson+-- not currently defined here+-- Map, LocalTime, ZonedTime, IntSet, CTime, Version, Natural+-- TimeOfDay, UTCTime, NominalDiffTime, Day, DiffTime, UUID, DotNetTime+-- Value, Dual, First, Last, IntMap, Tree, Seq, Vector, HashSet, Proxy+-- Const Tagged, Dual, First, Last, tuple up to length of 15+-}+++-- | Used to fill the type parameters of proxy types. `Proxy :: Proxy (Maybe TypeParameterRef0)`, `Proxy :: Proxy Either TypeParameterRef0 TypeParameterRef1`. JSON representation is as an Int to simplify the automated tests.+newtype TypeParameterRef0 = TypeParameterRef0 Int deriving (Read, Show, Eq, Generic)+instance Arbitrary TypeParameterRef0 where arbitrary = TypeParameterRef0 <$> arbitrary+instance ToADTArbitrary TypeParameterRef0+instance FromJSON TypeParameterRef0+instance ToJSON TypeParameterRef0+instance OCamlType TypeParameterRef0 where+  toOCamlType _ = OCamlDatatype (HaskellTypeMetaData "a0" "OCaml.BuckleScript.Types" "ocaml-export") "a0" $ OCamlValueConstructor $ NamedConstructor "a0" $ OCamlTypeParameterRef "a0"++-- | Second unique TypeParameterRef.+newtype TypeParameterRef1 = TypeParameterRef1 Int deriving (Read, Show, Eq, Generic)+instance Arbitrary TypeParameterRef1 where arbitrary = TypeParameterRef1 <$> arbitrary+instance ToADTArbitrary TypeParameterRef1+instance FromJSON TypeParameterRef1+instance ToJSON TypeParameterRef1+instance OCamlType TypeParameterRef1 where+  toOCamlType _ = OCamlDatatype (HaskellTypeMetaData "a1" "OCaml.BuckleScript.Types" "ocaml-export") "a1" $ OCamlValueConstructor $ NamedConstructor "a1" $ OCamlTypeParameterRef "a1"++-- | Third unique TypeParameterRef.+data TypeParameterRef2 = TypeParameterRef2 Int deriving (Read, Show, Eq, Generic)+instance Arbitrary TypeParameterRef2 where arbitrary = TypeParameterRef2 <$> arbitrary+instance ToADTArbitrary TypeParameterRef2+instance FromJSON TypeParameterRef2+instance ToJSON TypeParameterRef2+instance OCamlType TypeParameterRef2 where+  toOCamlType _ = OCamlDatatype (HaskellTypeMetaData "a2" "OCaml.BuckleScript.Types" "ocaml-export") "a2" $ OCamlValueConstructor $ NamedConstructor "a2" $ OCamlTypeParameterRef "a2"++-- | Fourth unique TypeParameterRef.+data TypeParameterRef3 = TypeParameterRef3 Int deriving (Read, Show, Eq, Generic)+instance Arbitrary TypeParameterRef3 where arbitrary = TypeParameterRef3 <$> arbitrary+instance ToADTArbitrary TypeParameterRef3+instance FromJSON TypeParameterRef3+instance ToJSON TypeParameterRef3+instance OCamlType TypeParameterRef3 where+  toOCamlType _ = OCamlDatatype (HaskellTypeMetaData "a3" "OCaml.BuckleScript.Types" "ocaml-export") "a3" $ OCamlValueConstructor $ NamedConstructor "a3" $ OCamlTypeParameterRef "a3"++-- | Fifth unique TypeParameterRef.+data TypeParameterRef4 = TypeParameterRef4 Int deriving (Read, Show, Eq, Generic)+instance Arbitrary TypeParameterRef4 where arbitrary = TypeParameterRef4 <$> arbitrary+instance ToADTArbitrary TypeParameterRef4+instance FromJSON TypeParameterRef4+instance ToJSON TypeParameterRef4+instance OCamlType TypeParameterRef4 where+  toOCamlType _ = OCamlDatatype (HaskellTypeMetaData "a4" "OCaml.BuckleScript.Types" "ocaml-export") "a4" $ OCamlValueConstructor $ NamedConstructor "a4" $ OCamlTypeParameterRef "a4"++-- | Sixth unique TypeParameterRef.+data TypeParameterRef5 = TypeParameterRef5 Int deriving (Read, Show, Eq, Generic)+instance Arbitrary TypeParameterRef5 where arbitrary = TypeParameterRef5 <$> arbitrary+instance ToADTArbitrary TypeParameterRef5+instance FromJSON TypeParameterRef5+instance ToJSON TypeParameterRef5+instance OCamlType TypeParameterRef5 where+  toOCamlType _ = OCamlDatatype (HaskellTypeMetaData "a5" "OCaml.BuckleScript.Types" "ocaml-export") "a5" $ OCamlValueConstructor $ NamedConstructor "a5" $ OCamlTypeParameterRef "a5"++-- Utility functions++-- | Whether a set of constructors is an enumeration, i.e. whether they lack+--   values. data A = A | B | C would be simple data A = A Int | B | C would not+--   be simple.+isEnumeration :: OCamlConstructor -> Bool+isEnumeration (OCamlValueConstructor (NamedConstructor _ OCamlEmpty)) = True+isEnumeration (OCamlValueConstructor (MultipleConstructors cs)) = all isEnumeration (OCamlValueConstructor <$> cs)+isEnumeration _ = False+++-- | Tranform an OCamlConstructor to EnumeratorConstructors +transformToEnumeration :: OCamlConstructor -> OCamlConstructor+transformToEnumeration (OCamlValueConstructor (NamedConstructor name OCamlEmpty)) =+  OCamlEnumeratorConstructor [EnumeratorConstructor name]++transformToEnumeration (OCamlValueConstructor (MultipleConstructors cs)) =+  -- wrap cs in OCamlValueConstructor so the type matches+  -- getEnumeratorConstructor to make sure it only returns OCamlEnumeratorConstructor+  -- then concat the results and rewrap it in OCamlEnumeratorConstructor+  OCamlEnumeratorConstructor . concat . catMaybes+    $ getEnumeratorConstructor . transformToEnumeration . OCamlValueConstructor+      <$> cs+  where+    getEnumeratorConstructor constructor =+      case constructor of+        (OCamlEnumeratorConstructor c) -> Just c+        _ -> Nothing+        +transformToEnumeration cs = cs++-- | transform a OCamlConstructor to OCamlSumOfRecordConstructor+transformToSumOfRecord :: Text -> OCamlConstructor -> OCamlConstructor+transformToSumOfRecord typeName (OCamlValueConstructor value@(MultipleConstructors _cs)) = OCamlSumOfRecordConstructor typeName value+transformToSumOfRecord _ constructor = constructor   +++-- | Haskell allows you to directly declare a sum of records,+-- i.e. data A = A {a :: Int} | B {b :: String}. This does not exist in+-- OCaml so we have to work around it.++isSumWithRecord :: OCamlConstructor -> Bool+isSumWithRecord (OCamlValueConstructor (MultipleConstructors cs)) =+  -- if there is only one constructor than it is not a SumWithRecords.+  -- if there are multiple constructors and at least one is a record constructor+  -- than it is a SumWithRecords+  (\x -> length x > 1 && or x) $ isSumWithRecordsAux . OCamlValueConstructor <$> cs+  where+    isSumWithRecordsAux :: OCamlConstructor -> Bool+    isSumWithRecordsAux (OCamlValueConstructor (RecordConstructor _ _)) = True+    isSumWithRecordsAux _ = False+isSumWithRecord _ = False++-- | Convert OCamlValues to the type parameter names of a data type.+--   `Either a0 a1` -> `["a0","a1"]`+getTypeParameterRefNames :: [OCamlValue] -> [Text]+getTypeParameterRefNames = nub . concat . (fmap match)+  where+    lift (OCamlDatatype _ _ constructor) = getTypeParameters constructor+    lift _ = []++    match value =+      case value of+        (OCamlTypeParameterRef name) -> [name]+        (Values v1 v2) -> match v1 ++ match v2+        (OCamlField _ v1) -> match v1+        (OCamlPrimitiveRef (OList v1)) -> lift v1+        (OCamlPrimitiveRef (OOption v1)) -> lift v1+        (OCamlPrimitiveRef (OTuple2 v1 v2)) -> lift v1 ++ lift v2+        (OCamlPrimitiveRef (OTuple3 v1 v2 v3)) -> lift v1 ++ lift v2 ++ lift v3+        (OCamlPrimitiveRef (OTuple4 v1 v2 v3 v4)) -> lift v1 ++ lift v2 ++ lift v3 ++ lift v4+        (OCamlPrimitiveRef (OTuple5 v1 v2 v3 v4 v5)) -> lift v1 ++ lift v2 ++ lift v3 ++ lift v4 ++ lift v5+        (OCamlPrimitiveRef (OTuple6 v1 v2 v3 v4 v5 v6)) -> lift v1 ++ lift v2 ++ lift v3 ++ lift v4 ++ lift v5 ++ lift v6+        _ -> []++-- | getOCamlValues flatten the values from MultipleConstructors into a list and remove ValueConstructor.+getOCamlValues :: ValueConstructor -> [OCamlValue]+getOCamlValues (NamedConstructor     _ value) = [value]+getOCamlValues (RecordConstructor    _ value) = [value]+getOCamlValues (MultipleConstructors cs)      = concat $ getOCamlValues <$> cs++-- | getTypePar+getTypeParameters :: OCamlConstructor -> [Text]+getTypeParameters (OCamlValueConstructor vc) = getTypeParameterRefNames . getOCamlValues $ vc+getTypeParameters (OCamlSumOfRecordConstructor _ vc) = getTypeParameterRefNames . getOCamlValues $ vc+getTypeParameters _ = []++-- | Matches all of the TypeParameterRefs (TypeParameterRef0 to TypeParameterRef5).+--   This function is needed to work around the tree structure for special rules for rendering type parameters.+isTypeParameterRef :: OCamlDatatype -> Bool+isTypeParameterRef (OCamlDatatype _ _ (OCamlValueConstructor (NamedConstructor _ (OCamlTypeParameterRef _)))) = True+isTypeParameterRef _ = False++-- | Make OCaml module prefix for a value based on the declaration's and parameter's meta data.+mkModulePrefix :: OCamlTypeMetaData -> OCamlTypeMetaData -> Text+mkModulePrefix (OCamlTypeMetaData _ decModules decSubModules) (OCamlTypeMetaData _ parModules parSubModules) =+  if prefix /= "" then prefix <> "." else ""+  where+    (l,r) = zipWithRightRemainder (decModules <> decSubModules) (parModules <> parSubModules)    +    prefix = T.intercalate "." $ (removeMatchingHead l) <> r++-- | Iterate through the beginning of a list, remove values as long as they are equal.+--   When one inequality is found, return the value and its tail.+removeMatchingHead :: Eq a => [(a,a)] -> [a]+removeMatchingHead [] = []+removeMatchingHead (hd:tl) =+  if fst hd == snd hd+  then removeMatchingHead tl+  else [snd hd] <> (snd <$> tl)++-- | Zip two lists. If the right hand side is longer, then return the remaining right side.+zipWithRightRemainder :: [a] -> [b] -> ([(a,b)], [b])+zipWithRightRemainder [] bs = ([], bs)+zipWithRightRemainder _ab [] = ([], [])+zipWithRightRemainder (a:as) (b:bs) = ([(a,b)], []) <> zipWithRightRemainder as bs

@@ -0,0 +1,62 @@+{-|+Module      : OCaml.Export+Description : Export everything from one module+Copyright   : Plow Technologies, 2017+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : experimental++-}++module OCaml.Export+  ( OCamlPackage+  , NoDependency+  , OCamlModule+  , OCamlSubModule+  , OCamlTypeInFile++  , PackageOptions (..)+  , defaultPackageOptions+  , SpecOptions (..)+  , defaultSpecOptions++  , EmbeddedOCamlFiles (..)++  , mkPackage+  , mkFiles+  , mkOCamlTypeMetaData+  +  -- OCaml.BuckleScript.Types+  , OCamlType (..)+  , TypeParameterRef0+  , TypeParameterRef1+  , TypeParameterRef2+  , TypeParameterRef3+  , TypeParameterRef4+  , TypeParameterRef5++  -- servant spec+  , mkOCamlSpecServer+  , MkOCamlSpecAPI+  , mkGoldenFiles++  -- re-export+  , Proxy (..)+  , (:>)+  , (:<|>) (..)+  , Application+  , Server+  , serve++  ) where++import Data.Proxy (Proxy (..))++import OCaml.BuckleScript.Types++import OCaml.BuckleScript.Internal.Module+import OCaml.BuckleScript.Internal.Package+import OCaml.BuckleScript.Internal.Spec++import Servant (Application, Server, serve)+import Servant.API ((:>), (:<|>) (..))

@@ -0,0 +1,89 @@+{-|+Module      : OCaml.File+Description : Create OCaml files+Copyright   : Plow Technologies, 2017+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : experimental++-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module OCaml.File where++-- base+import Data.ByteString (ByteString)+import Data.Monoid++-- directory+import System.Directory++-- text+import           Data.Text        (Text)+import qualified Data.Text        as T+import qualified Data.Text.IO     as T++-- file-embed+import Data.FileEmbed (embedFile)+++bsConfigFile :: ByteString+bsConfigFile = $(embedFile "bs-src/bsconfig.json")++packageFile :: ByteString+packageFile = $(embedFile "bs-src/package.json")++webpackConfigFile :: ByteString+webpackConfigFile = $(embedFile "bs-src/webpack.config.js")++data OCamlFile =+  OCamlFile+    { ocamlFilePath     :: FilePath+    , ocamlDeclarations :: [Text]+    }++data OCamlInterface =+  OCamlInterface+    { declars :: [Text]+    , inters :: [Text]+    , specs :: [Text]+    }++instance Monoid OCamlInterface where+  mappend a b = OCamlInterface (declars a <> declars b) (inters a <> inters b) (specs a <> specs b)+  mempty = OCamlInterface [] [] []++createOCamlFile :: FilePath -> OCamlFile -> IO ()+createOCamlFile rootDir ocamlFile = do+  createDirectoryIfMissing True rootDir+  let file = rootDir <> "/" <> ocamlFilePath ocamlFile <> ".ml"+      body = T.intercalate "\n\n" (ocamlDeclarations ocamlFile) <> "\n"    +  T.writeFile file body++createOCamlFiles :: FilePath ->  [OCamlFile] -> IO ()+createOCamlFiles root files = mapM_ (createOCamlFile root) files++createOCamlFileWithInterface :: FilePath -> FilePath -> FilePath -> OCamlInterface -> IO ()+createOCamlFileWithInterface rootDir specRootDir fileName ocamlInterface = do+  createDirectoryIfMissing True rootDir+  createDirectoryIfMissing True specRootDir+  let fp = rootDir <> "/" <> fileName+      body = T.intercalate "\n\n" (declars ocamlInterface) <> "\n"+      interfaceBody = T.intercalate "\n\n" (inters ocamlInterface) <> "\n"+  T.writeFile (fp <> ".ml") body+  T.writeFile (fp <> ".mli") interfaceBody+  if (length $ specs ocamlInterface) > 0+    then do+      let specfp = specRootDir <> "/" <> fileName+          specBody = "let () =\n" <> (T.intercalate "\n\n" (specs ocamlInterface) <> "\n")+      T.writeFile (specfp <> "_spec.ml") specBody+    else pure ()+  +createOCamlSpecFile :: FilePath -> FilePath -> Text -> IO ()+createOCamlSpecFile rootDir fileName ocamlSpec = do+  createDirectoryIfMissing True rootDir+  let fp = rootDir <> "/" <> fileName+      body = "let () =\n" <> ocamlSpec+  T.writeFile (fp <> "_spec.ml") body

@@ -0,0 +1,162 @@+{-|+Module      : OCaml.Internal.Common+Description : Internal utility functions+Copyright   : Plow Technologies, 2017+License     : BSD3+Maintainer  : mchaver@gmail.com+Stability   : experimental++-}+++{-# LANGUAGE OverloadedStrings #-}++module OCaml.Internal.Common where++-- base+import Data.Char (toLower,toUpper)+import qualified Data.List as L+import Data.Monoid++-- aeson+import qualified Data.Aeson.Types as Aeson (Options(..), defaultOptions)++-- containers+import qualified Data.Map.Strict as Map++-- formatting+import Formatting hiding (stext, text)++-- ocaml-export+import OCaml.BuckleScript.Types (HaskellTypeMetaData, OCamlTypeMetaData)++-- text+import Data.Text  (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT++-- wl-pprint+import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>))+++-- | For URLs and POSIX systems.+(</>) :: Text -> Text -> Text+(</>) a b =+    if hasEndingSeparator sA+    then+      if hasLeadingSeparator sB+      then T.pack $ sA ++ drop 1 sB+      else T.pack $ sA ++ sB+    else+      T.pack $ sA ++ "/" ++ sB+  where+    sA = T.unpack a+    sB = T.unpack b+    +    hasEndingSeparator :: String -> Bool+    hasEndingSeparator lst@(_hd:_tl) = (==) '/' . last $ lst+    hasEndingSeparator [] = False++    hasLeadingSeparator :: String -> Bool+    hasLeadingSeparator (hd:_tl) = hd == '/'+    hasLeadingSeparator [] = False++infix 5 </>+++data Options = Options+  { includeOCamlInterface :: Bool+  , aesonOptions :: Aeson.Options+  , dependencies :: Map.Map HaskellTypeMetaData OCamlTypeMetaData+  }++defaultOptions :: Options+defaultOptions = Options {includeOCamlInterface = False, aesonOptions = Aeson.defaultOptions, dependencies = Map.empty}++data TypeMetaData = TypeMetaData+  { topLevelOCamlTypeMetaData :: Maybe OCamlTypeMetaData -- Just if not primitive+  , userOptions :: Options+  }++cr :: Format r r+cr = now "\n"++mintercalate :: Monoid m => m -> [m] -> m+mintercalate _ [] = mempty+mintercalate _ [x] = x+mintercalate separator (x:xs) = x <> separator <> mintercalate separator xs++msuffix :: Monoid m => m -> [m] -> m+msuffix _ [] = mempty+msuffix suffix [x] = x <> suffix+msuffix suffix (x:xs) = x <> suffix <> msuffix suffix xs++mconcatWith :: Monoid m => m -> m -> [m] -> m+mconcatWith _   _   []     = mempty+mconcatWith pre suf [x]    = pre <> x <> suf+mconcatWith pre suf (x:xs) = pre <> x <> suf <> mconcatWith pre suf xs++mintercalatefinish :: Monoid m => m -> m -> [m] -> m+mintercalatefinish _ _ [] = mempty+mintercalatefinish _ f [x] = x <> f+mintercalatefinish separator f (x:xs) = x <> separator <> (mintercalatefinish separator f xs)++pprinter :: Doc -> Text+pprinter = LT.toStrict . displayT . renderPretty 0.4 100++stext :: Data.Text.Text -> Doc+stext = text . LT.fromStrict++spaceparens :: Doc -> Doc+spaceparens doc = "(" <+> doc <+> ")"+++-- | Parentheses of which the right parenthesis exists on a new line+newlineparens :: Doc -> Doc+newlineparens doc = "(" <> doc <$$> ")"++-- | An empty line, regardless of current indentation+emptyline :: Doc+emptyline = nest minBound linebreak++-- | Like <$$>, but with an empty line in between+(<$+$>) :: Doc -> Doc -> Doc+l <$+$> r = l <> emptyline <$$> r++linesBetween :: [Doc] -> Doc+linesBetween docs =+  let extra = if length docs > 0 then line else ""+  in foldl (<>) "" $ (L.intersperse (line <> line) docs) <> [extra]++squarebracks :: Doc -> Doc+squarebracks doc = "[" <+> doc <+> "]"++arraybrackets :: Doc -> Doc+arraybrackets doc = "[|" <+> doc <+> "|]"++pair :: Doc -> Doc -> Doc+pair l r = spaceparens $ l <> comma <+> r++lowercaseFirst :: String -> String+lowercaseFirst (hd:tl) = toLower hd : tl+lowercaseFirst [] = []++uppercaseFirst :: String -> String+uppercaseFirst (hd:tl) = toUpper hd : tl+uppercaseFirst [] = []++textLowercaseFirst :: Text -> Text+textLowercaseFirst = T.pack . lowercaseFirst . T.unpack++textUppercaseFirst :: Text -> Text+textUppercaseFirst = T.pack . uppercaseFirst . T.unpack++mkDocList :: [Doc] -> Doc+mkDocList ds =+  foldl (<>) "" $+    if length ds > 1+      then ["("] <> (L.intersperse ", " ds) <> [")"]+      else ds++foldMod :: [Text] -> Text+foldMod = T.intercalate "."

@@ -0,0 +1,154 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module Dependency where++-- base+import Data.Monoid ((<>))+import GHC.Generics (Generic)++-- aeson+import Data.Aeson (FromJSON, ToJSON)++-- containers+import Data.Map as Map++-- hspec+import Test.Hspec++-- hspec-aeson-golden+import Test.Aeson.Internal.ADT.GoldenSpecs++-- QuickCheck+import Test.QuickCheck++-- quickcheck-arbitrary-adt+import Test.QuickCheck.Arbitrary.ADT++-- text+import Data.Text (Text)++-- time+import Data.Time+import Data.Time.Clock.POSIX++-- ocaml-export+import OCaml.Export+import Product (ProductPackage, Person)+import Util++--mkGolden :: forall a. (ToADTArbitrary a, ToJSON a) => Proxy a -> IO ()+--mkGolden Proxy = mkGoldenFileForType 10 (Proxy :: Proxy a) "test/interface/golden/golden/dependency"++--mkGoldenFiles :: IO ()+--mkGoldenFiles = do+--  mkGolden (Proxy :: Proxy Class)++type DependencyPackage+  =    OCamlPackage "dependency" '[ProductPackage] :> (+       OCamlModule '["Class"] :> Class)++type DependencyPackageWithoutProduct+  =    OCamlPackage "dependency" NoDependency :> (+       OCamlModule '["Class"] :> Class)++type SchoolPackage+  =    OCamlPackage "school" '[DependencyPackage] :> (+       OCamlModule '["School"] :> School)+{-+data Person = Person+  { id :: Int+  , name :: Maybe String+  } deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance Arbitrary Person where+  arbitrary = Person <$> arbitrary <*> arbitrary++instance ToADTArbitrary Person+-}+data Class = Class+  { subject   :: String+  , students  :: [Person] -- from another package+  , professor :: Person+  } deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance Arbitrary Class where+  arbitrary = do+    k <- choose (1,3)+    v <- vector k+    Class <$> arbitrary <*> pure v <*> arbitrary++instance ToADTArbitrary Class++data School = School+  { schoolName :: String+  , classes :: [Class]+  , administrator :: Person+  } deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance Arbitrary School where+  arbitrary = do+    k <- choose (1,3)+    v <- vector k+    School <$> arbitrary <*> pure v <*> arbitrary++instance ToADTArbitrary School++data A =+  A Int+  deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance ToADTArbitrary A+instance Arbitrary A where+  arbitrary = A <$> arbitrary++data B =+  B String Int+  deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance ToADTArbitrary B+instance Arbitrary B where+  arbitrary = B <$> arbitrary <*> arbitrary++data C =+  C (Int,Int)+  deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance ToADTArbitrary C+instance Arbitrary C where+  arbitrary = C <$> arbitrary++data D =+  D String C+  deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance ToADTArbitrary D+instance Arbitrary D where+  arbitrary = D <$> arbitrary <*> arbitrary++data E =+  E Double+  deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance ToADTArbitrary E+instance Arbitrary E where+  arbitrary = E <$> arbitrary++type SubsPackage = OCamlPackage "subs" NoDependency :>+  (OCamlModule '["AtoE"] :> A :> (OCamlSubModule "One" :> B :> (OCamlSubModule "Two" :> C) :> D) :> E)+--   (OCamlModule '["AtoE"] :> OCamlSubModule '["One"] :> A)++spec :: Spec+spec = do+  runIO $ mkGoldenFiles (Proxy :: Proxy DependencyPackage) 10 "test/interface/golden/golden/dependency"+  runIO $ mkGoldenFiles (Proxy :: Proxy SubsPackage) 10 "test/interface/golden/golden/subs"+  runIO $ mkGoldenFiles (Proxy :: Proxy SchoolPackage) 10 "test/interface/golden/golden/school"+  let dir = "test/interface/temp"+  runIO $ mkPackage (Proxy :: Proxy DependencyPackage) (PackageOptions dir "dependency" Map.empty True Nothing)+  runIO $ mkPackage (Proxy :: Proxy SubsPackage) (PackageOptions dir "subs" Map.empty True Nothing)+  runIO $ mkPackage (Proxy :: Proxy SchoolPackage) (PackageOptions dir "school" Map.empty True Nothing)++  return ()

@@ -0,0 +1,86 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}++module File where++-- base+import Data.Proxy+import GHC.Generics (Generic)++-- aeson+import Data.Aeson++-- hspec+import Test.Hspec++-- hspec-golden-aeson+import Test.Aeson.Internal.ADT.GoldenSpecs++-- QuickCheck+import Test.QuickCheck++-- quickcheck-arbitrary-adt+import Test.QuickCheck.Arbitrary.ADT++-- ocaml-export+import OCaml.Export++type FilePackage = OCamlPackage "" NoDependency :>+  (OCamlModule '["File"]+    :> OCamlTypeInFile Person "test/ocaml/Person"+    :> Automobile+    :> OCamlTypeInFile Business "test/ocaml/Business"+    :> OCamlTypeInFile (Wrapper TypeParameterRef0 TypeParameterRef1) "test/ocaml/Wrapper"+  )++data Person = Person+  { id :: Int+  , name :: Maybe String+  } deriving (Show, Eq, Generic, FromJSON, ToJSON)++instance Arbitrary Person where+  arbitrary = Person <$> arbitrary <*> arbitrary++instance ToADTArbitrary Person+++data Automobile = Automobile+  { make :: String+  , model :: String+  , year :: Int+  } deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance Arbitrary Automobile where+  arbitrary = Automobile <$> arbitrary <*> arbitrary <*> arbitrary++instance ToADTArbitrary Automobile+++data Business = Business+  { taxId :: String+  , owner :: Person+  , employees :: [Person]+  , companyVehicle :: Maybe Automobile+  } deriving (Show, Eq, Generic, FromJSON, ToJSON)++instance Arbitrary Business where+  arbitrary = do+    employeeCount <- choose (0,3)+    Business <$> arbitrary <*> arbitrary <*> vector employeeCount <*> arbitrary++instance ToADTArbitrary Business++data Wrapper a b = Wrapper+  { wrapperA :: a+  , wrapperB :: b+  , wrapperC :: String+  } deriving (Show, Eq, Generic, FromJSON, ToJSON)++instance (Arbitrary a, Arbitrary b) => Arbitrary (Wrapper a b) where+  arbitrary = Wrapper <$> arbitrary <*> arbitrary <*> arbitrary++instance (ToADTArbitrary a, ToADTArbitrary b) => ToADTArbitrary (Wrapper a b)

@@ -0,0 +1,36 @@+{-# LANGUAGE DataKinds #-}++{-# LANGUAGE TemplateHaskell #-}++module FileApp where++-- containers+import qualified Data.Map as Map++-- hspec+import Test.Hspec++-- servant-server+import Servant++-- ocaml-export+import OCaml.Export+import File+import Util++$(mkOCamlSpecServer "FilePackage" (Proxy :: Proxy FilePackage))++fileMap :: Map.Map String EmbeddedOCamlFiles+fileMap = Map.fromList $(mkFiles True False (Proxy :: Proxy FilePackage))++compareInterfaceFiles = compareFiles "test/interface" "file" True++spec :: Spec+spec = do+  runIO $ mkGoldenFiles (Proxy :: Proxy FilePackage) 10 "test/interface/golden/golden/file"+  +  let dir = "test/interface/temp"+  runIO $ mkPackage (Proxy :: Proxy FilePackage) (PackageOptions dir "file" fileMap True $ Just $ SpecOptions "__tests__/file" "golden/file" "http://localhost:8083")++  describe "OCaml Declaration with Interface: Product Types" $ do+    compareInterfaceFiles "File"

@@ -0,0 +1,69 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module Options where++{-+import Data.Aeson (FromJSON, ToJSON)+import Data.Aeson.Types hiding (Options)+import Data.Char (toUpper,toLower)+import Data.Monoid ((<>))+import Data.Proxy+import Data.Text (Text)+import Data.Time+import Data.Time.Clock.POSIX+import GHC.Generics+import OCaml.Export hiding (Options,defaultOptions)+import qualified OCaml.Export as OCaml (Options,defaultOptions)+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Arbitrary.ADT+import Test.Aeson.Internal.ADT.GoldenSpecs+import Util+++testOptionsInterface = testOCamlTypeWithInterface Options++mkTestOCaml :: OCamlType a => Text -> a -> OCamlInterface+mkTestOCaml modul = mkOCamlInterfaceWithSpec "http://localhost:8081" "__tests__/golden/" modul++fieldUpperOptions = defaultOptions { fieldLabelModifier = map toUpper }++constructorLowerOptions = defaultOptions { constructorTagModifier = map toLower }++oo = OCaml.defaultOptions {aesonOptions = fieldUpperOptions }+ii = OCaml.defaultOptions {aesonOptions = constructorLowerOptions }++spec :: Spec+spec = do+  describe "OCaml Declaration with Interface: Types with Aeson Options" $ do+    testOptionsInterface "Person" (mkOCamlInterfaceWithOptions oo (Proxy :: Proxy Person))+    testOptionsInterface "NameOrIdNumber" (mkOCamlInterfaceWithOptions ii (Proxy :: Proxy NameOrIdNumber))++data Person = Person+  { id :: Int+  , name :: Maybe String+  , created :: UTCTime+  } deriving (Show, Eq, Generic, OCamlType)++instance Arbitrary Person where+  arbitrary = Person <$> arbitrary <*> arbitrary <*> arbitrary++instance ToADTArbitrary Person++instance ToJSON Person where+  toJSON = genericToJSON fieldUpperOptions++instance FromJSON Person where+  parseJSON = genericParseJSON fieldUpperOptions++data NameOrIdNumber = Name String | IdNumber Int+  deriving (Show, Eq, Generic, OCamlType)++instance ToJSON NameOrIdNumber where+  toJSON = genericToJSON constructorLowerOptions++instance FromJSON NameOrIdNumber where+  parseJSON = genericParseJSON constructorLowerOptions+-}

@@ -0,0 +1,222 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++{-# LANGUAGE FlexibleInstances #-}+++-- for OCaml Module+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++{-# LANGUAGE TemplateHaskell #-}+++module Product where++-- base+import Data.Monoid ((<>))+import GHC.Generics+-- text+import Data.Text (Text)+-- time+import Data.Time+import Data.Time.Clock.POSIX+-- containers+import qualified Data.Map as Map++-- aeson+import Data.Aeson (FromJSON, ToJSON)++-- hspec+import Test.Hspec+-- QuickCheck+import Test.QuickCheck+-- quickcheck-arbitrary-adt+import Test.QuickCheck.Arbitrary.ADT+-- hspec-golden-aeson+import Test.Aeson.Internal.ADT.GoldenSpecs+-- ocaml-export+import OCaml.Export hiding (mkGoldenFiles)+import Util++type ProductPackage+  = OCamlPackage "product" NoDependency+    :> (OCamlModule '["SimpleChoice"] :> SimpleChoice+  :<|> OCamlModule '["Person"] :> Person+  :<|> OCamlModule '["Company"] :> Company+  :<|> OCamlModule '["Card"] :> Suit :> Card+  :<|> OCamlModule '["CustomOption"] :> Company2+  :<|> OCamlModule '["OneTypeParameter"] :> OneTypeParameter TypeParameterRef0+  :<|> OCamlModule '["TwoTypeParameters"] :> TwoTypeParameters TypeParameterRef0 TypeParameterRef1+  :<|> OCamlModule '["ThreeTypeParameters"] :> Three TypeParameterRef0 TypeParameterRef1 TypeParameterRef2+  :<|> OCamlModule '["SubTypeParameter"] :> SubTypeParameter TypeParameterRef0 TypeParameterRef1 TypeParameterRef2)++mkGolden :: forall a. (ToADTArbitrary a, ToJSON a) => Proxy a -> IO ()+mkGolden Proxy = mkGoldenFileForType 10 (Proxy :: Proxy a) "test/interface/golden/golden/product"++mkGoldenFiles :: IO ()+mkGoldenFiles = do+  mkGolden (Proxy :: Proxy SimpleChoice)+  mkGolden (Proxy :: Proxy Person)+  mkGolden (Proxy :: Proxy Company)+  mkGolden (Proxy :: Proxy Suit)+  mkGolden (Proxy :: Proxy Card)+  mkGolden (Proxy :: Proxy Company2)+  mkGolden (Proxy :: Proxy (OneTypeParameter TypeParameterRef0))+  mkGolden (Proxy :: Proxy (TwoTypeParameters TypeParameterRef0 TypeParameterRef1))+  mkGolden (Proxy :: Proxy (Three TypeParameterRef0 TypeParameterRef1 TypeParameterRef2))+  mkGolden (Proxy :: Proxy (SubTypeParameter TypeParameterRef0 TypeParameterRef1 TypeParameterRef2))+  +compareInterfaceFiles = compareFiles "test/interface" "product" True++compareNoInterfaceFiles = compareFiles "test/nointerface" "product" False+++spec :: Spec+spec = do+  runIO $ mkGoldenFiles+  +  let dir = "test/interface/temp"+  runIO $ mkPackage (Proxy :: Proxy ProductPackage) (PackageOptions dir "product" Map.empty True $ Just $ SpecOptions "__tests__/product" "golden/product" "http://localhost:8081")+  +  describe "OCaml Declaration with Interface: Product Types" $ do+    compareInterfaceFiles "Person"+    compareInterfaceFiles "Company"+    compareInterfaceFiles "Card"+    compareInterfaceFiles "OneTypeParameter"+    compareInterfaceFiles "TwoTypeParameters"+    compareInterfaceFiles "ThreeTypeParameters"+    compareInterfaceFiles "SubTypeParameter"++  let dir2 = "test/nointerface/temp"+  runIO $ mkPackage (Proxy :: Proxy ProductPackage) (PackageOptions dir2 "product" Map.empty False Nothing)++  describe "OCaml Declaration without Interface: Product Types" $ do+    compareNoInterfaceFiles "Person"+    compareNoInterfaceFiles "Company"+    compareNoInterfaceFiles "Card"+    compareNoInterfaceFiles "OneTypeParameter"+    compareNoInterfaceFiles "TwoTypeParameters"+    compareNoInterfaceFiles "ThreeTypeParameters"+    compareNoInterfaceFiles "SubTypeParameter"++data SimpleChoice =+  SimpleChoice+    { choice :: Either String Int+    } deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance Arbitrary SimpleChoice where+  arbitrary = SimpleChoice <$> arbitrary++instance ToADTArbitrary SimpleChoice++data Person = Person+  { id :: Int+  , name :: Maybe String+  , created :: UTCTime+  } deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance Arbitrary Person where+  arbitrary = Person <$> arbitrary <*> arbitrary <*> arbitrary++instance ToADTArbitrary Person++data Company = Company+  { address   :: String+  , employees :: [Person]+  } deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance Arbitrary Company where+  arbitrary = do+    k <- choose (1,3)+    v <- vector k+    Company <$> arbitrary <*> pure v++instance ToADTArbitrary Company++data Company2 = Company2+  { address2   :: String+  , boss :: Maybe Person+  } deriving (Show, Eq, Generic, OCamlType, FromJSON, ToJSON)++instance Arbitrary Company2 where+  arbitrary = Company2 <$> arbitrary <*> arbitrary++instance ToADTArbitrary Company2++data Suit+  = Clubs+  | Diamonds+  | Hearts+  | Spades+  deriving (Eq,Show,Generic,OCamlType,FromJSON,ToJSON)++instance Arbitrary Suit where+  arbitrary = elements [Clubs, Diamonds, Hearts, Spades]++instance ToADTArbitrary Suit++data Card =+  Card+    { cardSuit  :: Suit+    , cardValue :: Int+    } deriving (Eq,Show,Generic,OCamlType,FromJSON,ToJSON)++instance Arbitrary Card where+  arbitrary = Card <$> arbitrary <*> arbitrary++instance ToADTArbitrary Card++data OneTypeParameter a =+  OneTypeParameter+    { otpId :: Int+    , otpFirst :: a+    } deriving (Eq,Show,Generic,OCamlType,FromJSON,ToJSON)++instance Arbitrary (OneTypeParameter TypeParameterRef0) where+  arbitrary = OneTypeParameter <$> arbitrary <*> arbitrary++instance ToADTArbitrary (OneTypeParameter TypeParameterRef0)++data TwoTypeParameters a b =+  TwoTypeParameters+    { ttpId :: Int+    , ttpFirst :: a+    , ttpSecond :: b+    } deriving (Eq,Show,Generic,OCamlType,FromJSON,ToJSON)++instance Arbitrary (TwoTypeParameters TypeParameterRef0 TypeParameterRef1) where+  arbitrary = TwoTypeParameters <$> arbitrary <*> arbitrary <*> arbitrary++instance ToADTArbitrary (TwoTypeParameters TypeParameterRef0 TypeParameterRef1)++data Three a b c =+  Three+    { threeId :: Int+    , threeFirst :: a+    , threeSecond :: b+    , threeThird :: c+    , threeString :: String+    } deriving (Eq,Show,Generic,OCamlType,FromJSON,ToJSON)++instance Arbitrary (Three TypeParameterRef0 TypeParameterRef1 TypeParameterRef2) where+  arbitrary = Three <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++instance ToADTArbitrary (Three TypeParameterRef0 TypeParameterRef1 TypeParameterRef2)++data SubTypeParameter a b c =+  SubTypeParameter+    { listA :: [a]+    , maybeB :: Maybe b+    , tupleC :: (c,b)+    } deriving (Eq,Show,Generic,OCamlType,FromJSON,ToJSON)++instance Arbitrary (SubTypeParameter TypeParameterRef0 TypeParameterRef1 TypeParameterRef2) where+  arbitrary = do+    k <- choose (1,3)+    v <- vector k+    SubTypeParameter <$> pure v <*> arbitrary <*> arbitrary++instance ToADTArbitrary (SubTypeParameter TypeParameterRef0 TypeParameterRef1 TypeParameterRef2)

@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}++module ProductApp where++import OCaml.Export+import Product++$(mkOCamlSpecServer "ProductPackage" (Proxy :: Proxy ProductPackage))

@@ -0,0 +1,97 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor      #-}+{-# LANGUAGE DeriveFoldable     #-}+{-# LANGUAGE DeriveTraversable  #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE KindSignatures  #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds  #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}++import Network.Wai.Handler.Warp+import Network.Wai+import Network.Wai.Middleware.RequestLogger (logStdout)+import System.Process++-- base+import Control.Concurrent (forkIO)+import Data.Monoid ((<>))+import GHC.TypeLits++-- ByteString+import Data.ByteString (unpack)++-- hspec+import           Test.Hspec++-- hspec-aeson-golden+import Test.Aeson.GenericSpecs+++-- servant+import Servant++-- servant-server+import Servant.API++-- text+import Data.Text (Text)++-- ocaml-export+import OCaml.Export+import qualified Dependency as D+import qualified File as File+import qualified FileApp as File+import qualified Options as Options+import qualified Product as Product+import ProductApp+import qualified Sum as Sum+import SumApp++logAllMiddleware :: Application -> Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived+logAllMiddleware app req respond = do+    d <- requestBody req+    print $ requestHeaders req+    print $ d+    app req respond++-- npm start --prefix path/to/your/app++main :: IO ()+main = do+  hspec Product.spec+  hspec Sum.spec+  hspec File.spec+--  hspec Options.spec+  hspec D.spec++  hspec $+    describe "mkOCamlTypeMetaData" $+      it "mkOCamlTypeMetaData on package A and B should equal mkOCamlTypeMetaData on B which has A as a dependency" $+        (mkOCamlTypeMetaData (Proxy :: Proxy Product.ProductPackage)) <> (mkOCamlTypeMetaData (Proxy :: Proxy D.DependencyPackageWithoutProduct))+          `shouldBe` mkOCamlTypeMetaData (Proxy :: Proxy D.DependencyPackage)++--  print $ ocamlPackageTypeCount (Proxy :: Proxy Product.ProductPackage)++--  print $ mkOCamlTypeMetaData (Proxy :: Proxy Product.ProductPackage)+  print $ mkOCamlTypeMetaData (Proxy :: Proxy D.SubsPackage)+  +  _ <- forkIO $ run 8081 productPackageApp+  _ <- forkIO $ run 8082 sumPackageApp+  run 8083 File.filePackageApp++-- curl -i -d '"hi"' -H 'Content-type: application/json' -X POST http://localhost:8081/x/y+ 

@@ -0,0 +1,179 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Sum where++-- base+import GHC.Generics++-- aeson+import Data.Aeson (FromJSON, ToJSON)++-- containers+import qualified Data.Map as Map++-- hspec+import Test.Hspec++-- QuickCheck+import Test.QuickCheck hiding (Result, Success)++-- quickcheck-arbitrary-adt+import Test.QuickCheck.Arbitrary.ADT+import Test.Aeson.Internal.ADT.GoldenSpecs++-- servant+import Servant.API++-- servant-server+import Servant++-- ocaml-export+import OCaml.Export hiding (mkGoldenFiles)+import Util+++type SumPackage+  = OCamlPackage "sum" NoDependency :>+       (OCamlModule '["OnOrOff"] :> OnOrOff+  :<|> OCamlModule '["NameOrIdNumber"] :> NameOrIdNumber+  :<|> OCamlModule '["SumVariant"] :> SumVariant+  :<|> OCamlModule '["WithTuple"] :> WithTuple+  :<|> OCamlModule '["SumWithRecord"] :> SumWithRecord+  :<|> OCamlModule '["Result"] :> Result TypeParameterRef0 TypeParameterRef1+  :<|> OCamlModule '["NewType"] :> NewType)++compareInterfaceFiles = compareFiles "test/interface" "sum" True++compareNoInterfaceFiles = compareFiles "test/nointerface" "sum" False++mkGolden :: forall a. (ToADTArbitrary a, ToJSON a) => Proxy a -> IO ()+mkGolden Proxy = mkGoldenFileForType 10 (Proxy :: Proxy a) "test/interface/golden/golden/sum"++mkGoldenFiles :: IO ()+mkGoldenFiles = do+  mkGolden (Proxy :: Proxy OnOrOff)+  mkGolden (Proxy :: Proxy NameOrIdNumber)+  mkGolden (Proxy :: Proxy SumVariant)+  mkGolden (Proxy :: Proxy WithTuple)+  mkGolden (Proxy :: Proxy SumWithRecord)+  mkGolden (Proxy :: Proxy (Result TypeParameterRef0 TypeParameterRef1))+  mkGolden (Proxy :: Proxy NewType) ++spec :: Spec+spec = do+  runIO mkGoldenFiles+  let dir = "test/interface/temp"+  runIO $ mkPackage (Proxy :: Proxy SumPackage) (PackageOptions dir "sum" Map.empty True $ Just $ SpecOptions "__tests__/sum" "golden/sum" "http://localhost:8082")++  describe "OCaml Declaration with Interface: Sum Types" $ do+    compareInterfaceFiles "OnOrOff"+    compareInterfaceFiles "NameOrIdNumber"+    compareInterfaceFiles "SumVariant"+    compareInterfaceFiles "WithTuple"+    compareInterfaceFiles "SumWithRecord"+    compareInterfaceFiles "Result"+    compareInterfaceFiles "NewType"+{-+  let dir2 = "test/nointerface/temp"+  runIO $ mkPackage (Proxy :: Proxy SumPackage) (PackageOptions dir2 "sum" Map.empty False Nothing)++  describe "Sum Types" $ do+    compareNoInterfaceFiles "OnOrOff"+    compareNoInterfaceFiles "NameOrIdNumber"+    compareNoInterfaceFiles "SumVariant"+    compareNoInterfaceFiles "WithTuple"+    compareNoInterfaceFiles "SumWithRecord"+    compareNoInterfaceFiles "Result"+    compareNoInterfaceFiles "NewType"+-}+    +data OnOrOff = On | Off+  deriving (Show,Eq,Generic,OCamlType,ToJSON,FromJSON)++instance Arbitrary OnOrOff where+  arbitrary = elements [On, Off]++instance ToADTArbitrary OnOrOff++data NameOrIdNumber = Name String | IdNumber Int+  deriving (Show, Eq, Generic, OCamlType,ToJSON,FromJSON)++instance Arbitrary NameOrIdNumber where+  arbitrary = oneof [Name <$> arbitrary, IdNumber <$> arbitrary]++instance ToADTArbitrary NameOrIdNumber++data Result a b+  = Success a+  | Error b+  deriving (Show, Eq, Generic, OCamlType, ToJSON, FromJSON)++instance Arbitrary (Result TypeParameterRef0 TypeParameterRef1) where+  arbitrary = oneof [Success <$> arbitrary, Error <$> arbitrary]++instance ToADTArbitrary (Result TypeParameterRef0 TypeParameterRef1)++data SumVariant+  = HasNothing+  | HasSingleInt Int+  | HasSingleTuple (Int,Int)+  | HasMultipleInts Int Int+  | HasMultipleTuples (Int,Int) (Int,Int)+  | HasMixed Int String Double+  deriving (Show,Eq,Generic, OCamlType, ToJSON, FromJSON)++instance Arbitrary SumVariant where+  arbitrary =+    oneof+      [ pure HasNothing+      , HasSingleInt <$> arbitrary+      , HasSingleTuple <$> arbitrary+      , HasMultipleInts <$> arbitrary <*> arbitrary+      , HasMultipleTuples <$> arbitrary <*> arbitrary+      , HasMixed <$> arbitrary <*> arbitrary <*> arbitrary+      ]++instance ToADTArbitrary SumVariant+++type Tuple+  = (Int,Int)++data WithTuple = WithTuple Tuple+  deriving (Show,Eq,Generic, OCamlType, ToJSON, FromJSON)++instance Arbitrary WithTuple where+  arbitrary = WithTuple <$> arbitrary++instance ToADTArbitrary WithTuple++data SumWithRecord+  = A1 {a1 :: Int}+  | B2 {b2 :: String, b3 :: Int}+  deriving (Show,Eq,Generic, OCamlType, ToJSON, FromJSON)++instance Arbitrary SumWithRecord where+  arbitrary =+    oneof+      [ A1 <$> arbitrary+      , B2 <$> arbitrary <*> arbitrary+      ]++instance ToADTArbitrary SumWithRecord++newtype NewType+  = NewType Int+  deriving (Show,Eq,Generic,OCamlType, ToJSON, FromJSON)++instance Arbitrary NewType where+  arbitrary = NewType <$> arbitrary++instance ToADTArbitrary NewType

@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}++module SumApp where++import OCaml.Export+import Sum++$(mkOCamlSpecServer "SumPackage" (Proxy :: Proxy SumPackage))

@@ -0,0 +1,91 @@+module Util where++-- base+import Data.Monoid ((<>))+import Data.Time++-- text+import qualified Data.Text.IO as T++-- ocaml-export+import OCaml.Export hiding (Options)+++import System.Directory (doesFileExist)++-- filepath+import System.FilePath.Posix ((</>))++-- hspec+import Test.Hspec++-- QuickCheck+import Test.QuickCheck++-- quickcheck-arbitrary-adt+import Test.QuickCheck.Arbitrary.ADT+import Test.Aeson.Internal.ADT.GoldenSpecs++instance Arbitrary UTCTime where+  arbitrary =+    UTCTime <$> (ModifiedJulianDay <$> (2000 +) <$> arbitrary)+            <*> pure 1.011+--            <*> (fromRational . toRational . (\f -> fromInteger $ round $ f * (10^2) / (10.0^^2)) <$> choose (0:: Double, 86400))++data ADT+  = Options++adtToPath :: ADT -> FilePath+adtToPath Options = "options"+++compareFiles :: FilePath -> FilePath -> Bool -> FilePath -> SpecWith ()+compareFiles rootDir categoryDir compareInterfaceAndSpecFiles typeName =+  it typeName $ do+    automated   <- T.readFile (testPath   </> typeName <> ".ml")+    handWritten <- T.readFile (goldenPath </> typeName <> ".ml")+    automated `shouldBe` handWritten+    if compareInterfaceAndSpecFiles+      then do+        automatedI   <- T.readFile (testPath   </> typeName <> ".mli")+        handWrittenI <- T.readFile (goldenPath </> typeName <> ".mli")+        automatedI `shouldBe` handWrittenI+        +        automatedS   <- T.readFile (testSpecPath   </> typeName <> "_spec" <> ".ml")+        handWrittenS <- T.readFile (goldenSpecPath </> typeName <> "_spec" <> ".ml")+        automatedS `shouldBe` handWrittenS+      else pure ()+  where+    testPath   = rootDir </> "temp" </> categoryDir+    goldenPath = rootDir </> "golden" </> categoryDir+    testSpecPath   = rootDir </> "temp" </> "__tests__" </> categoryDir+    goldenSpecPath = rootDir </> "golden" </> "__tests__" </> categoryDir++{-+testOCamlTypeWithInterface :: ADT -> FilePath -> OCamlInterface -> SpecWith ()+testOCamlTypeWithInterface adt typeName ocamlFile =+  it typeName $ do+    createOCamlFileWithInterface testPath specPath typeName ocamlFile+    automated   <- T.readFile (testPath   <> "/" <> typeName <> ".ml")+    handWritten <- T.readFile (goldenPath <> "/" <> typeName <> ".ml")++    automated2   <- T.readFile (testPath   <> "/" <> typeName <> ".mli")+    handWritten2 <- T.readFile (goldenPath <> "/" <> typeName <> ".mli")++    automated `shouldBe` handWritten+    automated2 `shouldBe` handWritten2++    fe <- doesFileExist (specGoldenPath <> "/" <> typeName <> "_spec.ml")+    if fe+      then do+        automated3   <- T.readFile (specPath <> "/" <> typeName <> "_spec.ml")+        handWritten3 <- T.readFile (specGoldenPath <> "/" <> typeName <> "_spec.ml")+        automated3 `shouldBe` handWritten3+      else pure ()+  where+    adtPath    = adtToPath adt+    testPath   = "test/interface/temp/" <> adtPath+    goldenPath = "test/interface/golden/" <> adtPath+    specPath  = "test/interface/temp/__tests__/" <> adtPath+    specGoldenPath  = "test/interface/golden/__tests__/" <> adtPath+-}