ocaml-export 0.5.0.0 → 0.6.0.0
raw patch · 11 files changed
+1054/−337 lines, 11 filesdep −constraintsdep ~basedep ~hspec-golden-aesondep ~template-haskell
Dependencies removed: constraints
Dependency ranges changed: base, hspec-golden-aeson, template-haskell
Files
- ocaml-export.cabal +8/−9
- src/OCaml/BuckleScript/Decode.hs +137/−93
- src/OCaml/BuckleScript/Encode.hs +175/−113
- src/OCaml/BuckleScript/Record.hs +116/−53
- src/OCaml/BuckleScript/Types.hs +302/−24
- src/OCaml/Internal/Common.hs +7/−0
- test/FileApp.hs +2/−2
- test/Product.hs +237/−9
- test/ProductApp.hs +1/−12
- test/Spec.hs +1/−2
- test/Sum.hs +68/−20
ocaml-export.cabal view
@@ -2,12 +2,12 @@ -- -- see: https://github.com/sol/hpack ----- hash: 13797e051898a65e9a1b27f7b146bf99ef415e50fbc55d7b0e5626ad4b6b9f8e+-- hash: 1958ab6ed0c01872336472224fcf702904c8cfb26230a75529ea37b5ab11a6d4 name: ocaml-export-version: 0.5.0.0+version: 0.6.0.0 synopsis: Convert Haskell types in OCaml types-description: README.md+description: Use GHC.Generics and Typeable to convert Haskell types to OCaml types. Convert aeson serialization to ocaml. category: Web homepage: https://github.com/plow-technologies/ocaml-export#readme bug-reports: https://github.com/plow-technologies/ocaml-export/issues@@ -26,7 +26,7 @@ library hs-source-dirs: src- ghc-options: -Wall+ ghc-options: -Wall -Wredundant-constraints -fprint-potential-instances build-depends: QuickCheck , aeson@@ -43,7 +43,7 @@ , servant , servant-server , split- , template-haskell+ , template-haskell <2.12.0.0 , text , time , typelits-witnesses@@ -72,20 +72,19 @@ build-depends: QuickCheck , aeson- , base+ , base >=4.7 && <5 , bytestring- , constraints , containers , directory , filepath , hspec- , hspec-golden-aeson+ , hspec-golden-aeson >=0.4.0.0 , ocaml-export , process , quickcheck-arbitrary-adt , servant , servant-server- , template-haskell+ , template-haskell <2.12.0.0 , text , time , typelits-witnesses
src/OCaml/BuckleScript/Decode.hs view
@@ -25,25 +25,42 @@ import Data.Maybe (catMaybes) import Data.Monoid import Data.Proxy (Proxy (..)) -+import Data.Typeable -- 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 +-- | 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)++-- Internal+ -- | Render OCamlDatatype into an OCaml declaration class HasDecoder a where render :: a -> Reader TypeMetaData Doc@@ -72,21 +89,6 @@ 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@@ -137,7 +139,7 @@ if ocamlInterface then do let typeParameters = getTypeParameters constructor- renderedTypeParameters = foldl (<>) "" $ stext <$> L.intersperse " " ((\t -> "decode" <> (textUppercaseFirst t)) <$> typeParameters)+ renderedTypeParameters = foldl (<>) "" $ stext <$> L.intersperse " " ((\t -> "decode" <> (textUppercaseFirst t)) <$> (L.sort typeParameters)) pure $ "let" <+> fnName <+> renderedTypeParameters <+> "json" <+> "=" <$$> fnBody else do let (typeParameterSignatures,typeParameters) = renderTypeParameters constructor@@ -147,6 +149,21 @@ render (OCamlPrimitive primitive) = renderRef primitive instance HasDecoderRef OCamlDatatype where+ renderRef (OCamlDatatype typeRef _ (OCamlValueConstructor (NamedConstructor _ (OCamlRefApp typRep values)))) = do+ let name = "decode" <> (stext $ textUppercaseFirst $ T.pack $ show $ fst $ splitTyConApp typRep)+ dx <- renderRef values++ mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData + case mOCamlTypeMetaData of+ Nothing -> pure $ parens $ name <+> dx+ Just decOCamlTypeMetaData -> do+ ds <- asks (dependencies . userOptions)+ case Map.lookup (typeRepToHaskellTypeMetaData typRep) ds of+ Just parOCamlTypeMetaData -> do+ let prefix = stext $ mkModulePrefix decOCamlTypeMetaData parOCamlTypeMetaData+ pure $ parens $ prefix <> name <+> dx+ Nothing -> fail ("OCaml.BuckleScript.Decode (HasDecoderRef OCamlDataType) expected to find dependency:\n\n" ++ show typeRef ++ "\n\nin\n\n" ++ show ds)+ -- this should only catch type parameters renderRef datatype@(OCamlDatatype typeRef name _) = if isTypeParameterRef datatype@@ -167,18 +184,6 @@ renderRef (OCamlPrimitive primitive) = renderRef primitive ---- | 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 ]- instance HasDecoder OCamlConstructor where render (OCamlValueConstructor (NamedConstructor name value)) = do decoder <- render value@@ -215,74 +220,77 @@ <$$> "| 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+ Just ocamlTypeRef -> 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))"+ pure $ appendModule ds ocamlTypeRef typeRef 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 $ "(fun a -> unwrapResult (decode" <> (stext . textUppercaseFirst $ name) <+> "a))" + render ref@(OCamlRefApp typRep values) = do+ mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData+ case mOCamlTypeMetaData of+ Nothing -> fail $ "OCaml.BuckleScript.Record (HasType (OCamlDatatype typeRep name)) mOCamlTypeMetaData is Nothing:\n\n" ++ (show ref)+ Just ocamlTypeRef -> do+ ds <- asks (dependencies . userOptions)+ dx <- renderRef values+ pure $ appendModule ds ocamlTypeRef (typeRepToHaskellTypeMetaData typRep) (T.pack $ show $ fst $ splitTyConApp typRep) (wrapIfPrimitive values dx) render (OCamlPrimitiveRef primitive) = renderRef primitive - render (OCamlTypeParameterRef name) =- pure $ "(fun a -> unwrapResult (decode" <> (stext . textUppercaseFirst $ name) <+> "a))"+ render (OCamlTypeParameterRef name) = pure $ "decode" <> (stext . textUppercaseFirst $ name) render (Values x y) = do dx <- render x dy <- render y- return $ dx <$$> ";" <+> dy+ pure $ 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 (OCamlRefAppValues x y) = do+ dx <- render x+ dy <- render y+ pure $ (wrapIfPrimitive x dx) <+> (wrapIfPrimitive y dy) 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"+ pure $ (stext name) <+> "=" <+> "field" <+> dquotes (stext jsonFieldname) <+> (unwrapIfTypeParameter value dv) <+> "json" - render OCamlEmpty = pure (stext "")+ render OCamlEmpty = pure "" instance HasDecoder EnumeratorConstructor where render (EnumeratorConstructor name) = pure $ "| Some \"" <> stext name <> "\" -> Js_result.Ok" <+> stext name +instance HasDecoderRef OCamlValue where+ renderRef (OCamlRefAppValues x y) = do+ dx <- render x+ dy <- render y+ pure $ (wrapIfPrimitive x dx) <+> (wrapIfPrimitive y dy)++ renderRef (OCamlPrimitiveRef primitive) = renderRef primitive++ renderRef _ = pure ""+ 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 OChar = pure "string"+ renderRef ODate = pure "date" renderRef OFloat = pure "Aeson.Decode.float" -- this is to prevent overshadowing warning+ renderRef OInt = pure "int" renderRef OString = pure "string"+ renderRef OUnit = pure $ parens "()" renderRef (OList (OCamlPrimitive OChar)) = pure "string" - renderRef (OList datatype) = do- dt <- renderRefWithUnwrapResult datatype- pure . parens $ "list" <+> dt+ renderRef (OList v0) = do+ dv0 <- renderRefWithUnwrapResult v0+ pure . parens $ "list" <+> dv0 - renderRef (OOption _) = pure ""+ renderRef (OOption v0) = do+ dv0 <- renderRefWithUnwrapResult v0+ pure . parens $ "optional" <+> dv0 renderRef (OEither v0 v1) = do dv0 <- renderRefWithUnwrapResult v0@@ -325,8 +333,46 @@ pure $ parens $ "tuple6" <+> dv0 <+> dv1 <+> dv2 <+> dv3 <+> dv4 <+> dv5 -- Util+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++-- | 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 ]+ renderRefWithUnwrapResult :: OCamlDatatype -> Reader TypeMetaData Doc+renderRefWithUnwrapResult (OCamlDatatype typeRef _ (OCamlValueConstructor (NamedConstructor _ (OCamlRefApp typRep values)))) = do+ let name = "decode" <> (stext $ textUppercaseFirst $ T.pack $ show $ fst $ splitTyConApp typRep)+ dx <- renderRef values++ mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData + case mOCamlTypeMetaData of+ Nothing -> pure $ parens $ name <+> (wrapIfPrimitive values dx)+ Just decOCamlTypeMetaData -> do+ ds <- asks (dependencies . userOptions)+ case Map.lookup (typeRepToHaskellTypeMetaData typRep) ds of+ Just parOCamlTypeMetaData -> do+ let prefix = stext $ mkModulePrefix decOCamlTypeMetaData parOCamlTypeMetaData + pure $ parens $ "fun a -> unwrapResult (" <> prefix <> name <+> (wrapIfPrimitive values dx) <+> "a)"+ Nothing -> fail ("OCaml.BuckleScript.Decode (HasDecoderRef OCamlDataType) expected to find dependency:\n\n" ++ show typeRef ++ "\n\nin\n\n" ++ show ds)+ renderRefWithUnwrapResult datatype@(OCamlDatatype typeRef name _) = do if isTypeParameterRef datatype then@@ -366,7 +412,7 @@ 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"+ ("match Aeson.Decode." <> parens ("field \"contents\"" <+> (unwrapIfTypeParameter value val) <+> "json") <+> "with" <$$> indent 1 ( "| v -> Js_result.Ok (" <> (stext name) <+> "v)"@@ -405,8 +451,8 @@ 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.+-- 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]@@ -442,7 +488,7 @@ renderTypeParameterValsAux :: [OCamlValue] -> (Doc,Doc) renderTypeParameterValsAux ocamlValues =- let typeParameterNames = (<>) "'" <$> getTypeParameterRefNames ocamlValues+ let typeParameterNames = (<>) "'" <$> (L.sort $ getTypeParameterRefNames ocamlValues) typeDecs = (foldl (<>) "" $ L.intersperse " -> " $ (\t -> "(Js_json.t -> (" <> (stext t) <> ", string) Js_result.t)") <$> typeParameterNames) <> " -> " in if length typeParameterNames > 0@@ -482,25 +528,23 @@ Just $ "val decode" <> (stext $ typeName <> name) <+> ":" <+> "Js_json.t" <+> "->" <+> parens (stext (textLowercaseFirst $ typeName <> name) <> comma <+> "string") <+> "Js_result.t" renderSumRecordInterface _ _ = Nothing ---- Exported+-- | If this type comes from a different OCaml module, then add the appropriate module prefix and add unwrapResult to make the+-- types match+appendModule :: Map.Map HaskellTypeMetaData OCamlTypeMetaData -> OCamlTypeMetaData -> HaskellTypeMetaData -> Text -> Doc -> Doc+appendModule m o h name nxt =+ case Map.lookup h m of+ Just parOCamlTypeMetaData ->+ (stext $ mkModulePrefix o parOCamlTypeMetaData) <> "decode" <> (stext $ textUppercaseFirst name) <+> nxt+ -- 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 -> "decode" <> (stext $ textUppercaseFirst name) <+> nxt --- | 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)+wrapIfPrimitive :: OCamlValue -> Doc -> Doc+wrapIfPrimitive (OCamlPrimitiveRef _) doc = parens $ "wrapResult" <+> doc+wrapIfPrimitive _ doc = doc --- | 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)+unwrapIfTypeParameter :: OCamlValue -> Doc -> Doc+unwrapIfTypeParameter (OCamlTypeParameterRef _) doc = parens $ "fun a -> unwrapResult" <+> (parens $ doc <+> "a")+unwrapIfTypeParameter (OCamlRef _ _) doc = parens $ "fun a -> unwrapResult" <+> (parens $ doc <+> "a")+unwrapIfTypeParameter (OCamlRefApp _ _) doc = parens $ "fun a -> unwrapResult" <+> (parens $ doc <+> "a")+unwrapIfTypeParameter _ doc = doc
src/OCaml/BuckleScript/Encode.hs view
@@ -24,6 +24,7 @@ import Data.Maybe (catMaybes) import Data.Monoid import Data.Proxy (Proxy (..))+import Data.Typeable -- aeson import qualified Data.Aeson.Types as Aeson (Options(..))@@ -42,6 +43,28 @@ import OCaml.BuckleScript.Types import OCaml.Internal.Common +-- | 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)++-- util+ -- | Render the encoder function class HasEncoder a where render :: a -> Reader TypeMetaData Doc@@ -135,6 +158,25 @@ -- | produce encode function name for data types and primitives instance HasEncoderRef OCamlDatatype where+ -- when ocamlrefapp is reference by a primitive+ renderRef (OCamlDatatype _ _ (OCamlValueConstructor (NamedConstructor _ (OCamlRefApp typRep values)))) = do+ let name = "encode" <> (stext $ textUppercaseFirst $ T.pack $ show $ fst $ splitTyConApp typRep)+ dx <- renderRef values++ mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData + case mOCamlTypeMetaData of+ Nothing -> pure $ parens $ name <+> dx+ Just decOCamlTypeMetaData -> do+ ds <- asks (dependencies . userOptions)+ case Map.lookup (typeRepToHaskellTypeMetaData typRep) ds of+ Just parOCamlTypeMetaData -> do+ let prefix = stext $ mkModulePrefix decOCamlTypeMetaData parOCamlTypeMetaData+ pure $ parens $ prefix <> name <+> dx++ -- 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 $ parens $ name <+> dx+ renderRef datatype@(OCamlDatatype typeRef name _) = do if isTypeParameterRef datatype then@@ -196,7 +238,121 @@ render _ = 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 ocamlTypeRef -> do+ ds <- asks (dependencies . userOptions)+ pure . stext $ appendModule ds ocamlTypeRef typeRef name++ render ref@(OCamlRefApp typRep values) = do+ mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData+ case mOCamlTypeMetaData of+ Nothing -> fail $ "OCaml.BuckleScript.Encode (HasEncoder (OCamlRef typeRep name)) mOCamlTypeMetaData is Nothing:\n\n" ++ (show ref)+ Just ocamlTypeRef -> do+ ds <- asks (dependencies . userOptions)+ dx <- renderRef values+ pure $ parens $+ (stext $ appendModule ds ocamlTypeRef (typeRepToHaskellTypeMetaData typRep)+ (T.pack $ show $ fst $ splitTyConApp typRep))+ <+> dx++ render (Values x y) = do+ dx <- render x+ dy <- render y+ pure $ dx <$$> ";" <+> dy++ render (OCamlRefAppValues x y) = do+ dx <- render x+ dy <- render y+ return $ dx <+> dy++ render OCamlEmpty = pure ""++instance HasEncoderRef OCamlValue where+ renderRef (OCamlRefAppValues x y) = do+ dx <- render x+ dy <- render y+ pure $ dx <+> dy++ renderRef (OCamlPrimitiveRef primitive) = renderRef primitive++ renderRef _ = pure "" ++instance HasEncoderRef OCamlPrimitive where+ renderRef OBool = pure "Aeson.Encode.bool"+ renderRef OChar = pure "Aeson.Encode.string"+ renderRef ODate = pure "Aeson.Encode.date"+ renderRef OFloat = pure "Aeson.Encode.float"+ renderRef OInt = pure "Aeson.Encode.int"+ renderRef OString = pure "Aeson.Encode.string"+ renderRef OUnit = pure "Aeson.Encode.null"++ renderRef (OList (OCamlPrimitive OChar)) = pure "Aeson.Encode.string"++ renderRef (OList datatype) = do+ dd <- renderRef datatype+ pure . parens $ "Aeson.Encode.list" <+> dd++ renderRef (OOption datatype) = do+ dd <- renderRef datatype+ pure . parens $ "Aeson.Encode.optional" <+> dd++ renderRef (OEither t0 t1) = do+ dt0 <- renderRef t0+ dt1 <- renderRef t1+ pure . parens $ "Aeson.Encode.either" <+> dt0 <+> dt1++ renderRef (OTuple2 t0 t1) = do+ dt0 <- renderRef t0+ dt1 <- renderRef t1+ pure . parens $ "Aeson.Encode.pair" <+> dt0 <+> dt1++ renderRef (OTuple3 t0 t1 t2) = do+ dt0 <- renderRef t0+ dt1 <- renderRef t1+ dt2 <- renderRef t2+ pure . parens $ "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+ pure . parens $ "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+ pure . parens $ "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+ pure . parens $ "Aeson.Encode.tuple6" <+> dt0 <+> dt1 <+> dt2 <+> dt3 <+> dt4 <+> dt5+ -- | special rendering function for sum with record types renderSumRecord :: Text -> OCamlConstructor -> Reader TypeMetaData (Maybe Doc) renderSumRecord typeName (OCamlValueConstructor (RecordConstructor name value)) = do@@ -295,96 +451,6 @@ 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.bool"- 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- pure . parens $ "Aeson.Encode.list" <+> dd-- renderRef (OOption datatype) = do- dd <- renderRef datatype- pure . parens $ "Aeson.Encode.optional" <+> dd-- renderRef (OEither t0 t1) = do- dt0 <- renderRef t0- dt1 <- renderRef t1- pure . parens $ "Aeson.Encode.either" <+> dt0 <+> dt1-- renderRef (OTuple2 t0 t1) = do- dt0 <- renderRef t0- dt1 <- renderRef t1- pure . parens $ "Aeson.Encode.pair" <+> dt0 <+> dt1-- renderRef (OTuple3 t0 t1 t2) = do- dt0 <- renderRef t0- dt1 <- renderRef t1- dt2 <- renderRef t2- pure . parens $ "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- pure . parens $ "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- pure . parens $ "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- pure . parens $ "Aeson.Encode.tuple6" <+> dt0 <+> dt1 <+> dt2 <+> dt3 <+> dt4 <+> dt5- -- | Variable names for the members of constructors -- Used in pattern matches constructorParameters :: Int -> OCamlValue -> [Doc]@@ -396,7 +462,6 @@ 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@@ -404,6 +469,9 @@ renderVariable (d : ds) v@(OCamlRef {}) = do v' <- render v return (v' <+> d, ds)+renderVariable (d : ds) v@(OCamlRefApp {}) = do+ v' <- render v+ return (v' <+> d, ds) renderVariable ds OCamlEmpty = return (empty, ds) renderVariable (_ : ds) (OCamlPrimitiveRef OUnit) = return ("Aeson.Encode.null", ds)@@ -417,9 +485,14 @@ (left, dsl) <- renderVariable ds l (right, dsr) <- renderVariable dsl r return (left <+> ";" <+> right, dsr)+renderVariable ds (OCamlRefAppValues 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@@ -439,7 +512,7 @@ -- | Helper function for renderTypeParameterVals renderTypeParameterValsAux :: [OCamlValue] -> (Doc,Doc) renderTypeParameterValsAux ocamlValues =- let typeParameterNames = (<>) "'" <$> getTypeParameterRefNames ocamlValues+ let typeParameterNames = (<>) "'" <$> (L.sort $ getTypeParameterRefNames ocamlValues) typeDecs = (\t -> "(" <> (stext t) <+> "-> Js_json.t)") <$> typeParameterNames in if length typeDecs > 0@@ -475,25 +548,14 @@ -- `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)+ foldl (<>) "" $ stext <$> L.intersperse " " ((\t -> "encode" <> (textUppercaseFirst t)) <$> (L.sort (getTypeParameters constructor))) --- | 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)+-- | If this type comes from a different OCaml module, then add the appropriate module prefix+appendModule :: Map.Map HaskellTypeMetaData OCamlTypeMetaData -> OCamlTypeMetaData -> HaskellTypeMetaData -> Text -> Text+appendModule m o h name =+ case Map.lookup h m of+ Just parOCamlTypeMetaData -> + (mkModulePrefix o parOCamlTypeMetaData) <> "encode" <> (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 -> "encode" <> textUppercaseFirst name
src/OCaml/BuckleScript/Record.hs view
@@ -19,10 +19,11 @@ -- base import Control.Monad.Reader-import Data.List (nub)+import Data.List (nub, sort) import Data.Maybe (catMaybes) import Data.Monoid import Data.Proxy (Proxy (..))+import Data.Typeable -- containers import qualified Data.Map.Strict as Map@@ -38,20 +39,34 @@ -- wl-pprint import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>)) +-- | 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)++-- Internal functions to convert OCamlDatatype into BuckleScript source code.+ -- | render a Haskell data type in OCaml class HasType a where render :: a -> Reader TypeMetaData Doc +-- | render the rows of a record type class HasRecordType a where renderRecord :: a -> Reader TypeMetaData Doc +-- | render a type as a reference, not its implementation details 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.+ -- before and separate from the main sum type. sumRecordsData <- catMaybes <$> sequence (renderSumRecord typeName <$> constructors) let sumRecords = msuffix (line <> line) (fst <$> sumRecordsData) newConstructors = replaceRecordConstructors (snd <$> sumRecordsData) <$> constructors@@ -75,6 +90,20 @@ render (OCamlPrimitive primitive) = renderRef primitive instance HasTypeRef OCamlDatatype where+ renderRef (OCamlDatatype _ _ (OCamlValueConstructor (NamedConstructor _ (OCamlRefApp typRep values)))) = do+ dx <- renderRef values+ let name = stext . textLowercaseFirst . T.pack . show $ typeRepTyCon typRep+ mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData + case mOCamlTypeMetaData of+ Nothing -> pure $ (parensIfNotBlank dx) <+> name+ Just decOCamlTypeMetaData -> do+ ds <- asks (dependencies . userOptions)+ case Map.lookup (typeRepToHaskellTypeMetaData typRep) ds of+ Just parOCamlTypeMetaData -> do+ let prefix = stext $ mkModulePrefix decOCamlTypeMetaData parOCamlTypeMetaData+ pure $ (parensIfNotBlank dx) <+> prefix <> name+ Nothing -> fail ("expected to find dependency:\n\n" ++ "\n\nin\n\n" ++ show ds)+ renderRef datatype@(OCamlDatatype typeRef typeName _) = do if isTypeParameterRef datatype then@@ -94,95 +123,140 @@ renderRef (OCamlPrimitive primitive) = renderRef primitive +instance HasTypeRef OCamlValue where+ renderRef (OCamlRefAppValues x y) = do+ dx <- render x+ dy <- render y+ pure $ dx <> comma <+> dy++ renderRef (OCamlPrimitiveRef primitive) = renderRef primitive+ renderRef _ = pure ""+ instance HasType OCamlConstructor where render (OCamlValueConstructor value) = render value render (OCamlSumOfRecordConstructor _ value) = render value- render (OCamlEnumeratorConstructor constructors) = do+ render (OCamlEnumeratorConstructor constructors) = mintercalate (line <> "|" <> space) <$> sequence (render <$> constructors) instance HasType ValueConstructor where- -- record+ -- record constructor render (RecordConstructor _ value) = do fields <- renderRecord value pure $ "{" <+> fields <$$> "}" - -- enumerator+ -- enumerator constructor render (NamedConstructor constructorName (OCamlEmpty)) = do pure $ stext constructorName - -- product+ -- constructor with one or more values render (NamedConstructor constructorName value) = do types <- render value pure $ stext constructorName <+> "of" <+> types - -- sum+ -- multiple constructors (sum type) 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+ Just ocamlTypeRef -> 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+ pure . stext $ appendModule ds ocamlTypeRef typeRef name - render (OCamlTypeParameterRef name) = pure (stext ("'" <> name))+ render (OCamlRefApp typRep values) = do+ mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData+ case mOCamlTypeMetaData of+ Nothing -> fail $ "OCaml.BuckleScript.Record (HasType (OCamlDatatype typeRep name)) mOCamlTypeMetaData is Nothing:\n\n"+ Just ocamlTypeRef -> do+ ds <- asks (dependencies . userOptions)+ dx <- renderRef values+ pure $ (parensIfNotBlank dx) <+> (stext $ appendModule ds ocamlTypeRef (typeRepToHaskellTypeMetaData typRep) (T.pack . show $ typeRepTyCon typRep))++ 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+ pure $ dx <+> "*" <+> dy++ render (OCamlRefAppValues x y) = do+ dx <- render x+ dy <- render y+ pure $ dx <> comma <+> dy+ render (OCamlField name value) = do dv <- renderRecord value- return $ stext name <+> ":" <+> dv+ pure $ stext name <+> ":" <+> dv + render OCamlEmpty = pure ""+ instance HasRecordType OCamlValue where- renderRecord (OCamlPrimitiveRef primitive) = renderRef primitive renderRecord (Values x y) = do dx <- renderRecord x dy <- renderRecord y- return $ dx <$$> ";" <+> dy+ pure $ dx <$$> ";" <+> dy++ renderRecord (OCamlPrimitiveRef primitive) = renderRef primitive renderRecord value = render value instance HasTypeRef OCamlPrimitive where+ renderRef OBool = pure "bool"+ renderRef OChar = pure "string"+ renderRef ODate = pure "Js_date.t"+ renderRef OFloat = pure "float"+ renderRef OInt = pure "int"+ renderRef OString = pure "string"+ renderRef OUnit = pure "unit"+ renderRef (OList (OCamlPrimitive OChar)) = renderRef OString+ renderRef (OList datatype) = do dt <- renderRef datatype- return $ parens dt <+> "list"+ pure $ parens dt <+> "list"++ renderRef (OOption datatype) = do+ dt <- renderRef datatype+ pure $ parens dt <+> "option"++ renderRef (OEither k v) = do+ dk <- renderRef k+ dv <- renderRef v+ pure $ (parens $ dk <> comma <+> dv) <+> "Aeson.Compatibility.Either.t"+ renderRef (OTuple2 a b) = do da <- renderRef a db <- renderRef b- return . parens $ da <+> "*" <+> db+ pure . parens $ da <+> "*" <+> db+ renderRef (OTuple3 a b c) = do da <- renderRef a db <- renderRef b dc <- renderRef c- return . parens $ da <+> "*" <+> db <+> "*" <+> dc+ pure . 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+ pure . 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+ pure . parens $ da <+> "*" <+> db <+> "*" <+> dc <+> "*" <+> dd <+> "*" <+> de+ renderRef (OTuple6 a b c d e f) = do da <- renderRef a db <- renderRef b@@ -190,21 +264,7 @@ 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"+ pure . parens $ da <+> "*" <+> db <+> "*" <+> dc <+> "*" <+> dd <+> "*" <+> de <+> "*" <+> df -- Util functions @@ -227,7 +287,7 @@ -- (Maybe a) -> 'a0 list -> ["'a0"] -- (Either a b) -> 'a0 'a1 list -> ["'a0","'a1"] renderTypeParameters :: OCamlConstructor -> Doc-renderTypeParameters constructor = mkDocList $ stext . (<>) "'" <$> (nub $ getTypeParameters constructor)+renderTypeParameters constructor = mkDocList $ stext . (<>) "'" <$> sort (nub $ getTypeParameters constructor) -- | For Haskell Sum of Records, create OCaml record types of each RecordConstructor renderSumRecord :: Text -> ValueConstructor -> Reader TypeMetaData (Maybe (Doc,(Text,ValueConstructor)))@@ -235,8 +295,18 @@ let sumRecordName = typeName <> name functionBody <- render constructor pure $ Just (("type" <+> (stext (textLowercaseFirst sumRecordName)) <+> "=" <$$> indent 2 functionBody), (name, (RecordConstructor sumRecordName value)))-renderSumRecord _ _ = return Nothing+renderSumRecord _ _ = pure Nothing +-- | If this type comes from a different OCaml module, then add the appropriate module prefix+appendModule :: Map.Map HaskellTypeMetaData OCamlTypeMetaData -> OCamlTypeMetaData -> HaskellTypeMetaData -> Text -> Text+appendModule m o h name =+ case Map.lookup h m of+ Just parOCamlTypeMetaData -> + (mkModulePrefix o parOCamlTypeMetaData) <> (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 -> textLowercaseFirst name+ -- | Puts parentheses around the doc of an OCaml ref if it contains spaces. ocamlRefParens :: OCamlPrimitive -> Doc -> Doc ocamlRefParens (OList (OCamlPrimitive OChar)) = id@@ -244,12 +314,5 @@ 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)+parensIfNotBlank :: Doc -> Doc+parensIfNotBlank d = let dx = show d in if (length dx) > 0 && dx /= " " then parens d else d
src/OCaml/BuckleScript/Types.hs view
@@ -51,6 +51,10 @@ , isTypeParameterRef , mkModulePrefix , oCamlValueIsFloat++ -- Typeable functions+ , typeRepToHaskellTypeMetaData+ , tyConToHaskellTypeMetaData ) where -- base@@ -66,6 +70,8 @@ import GHC.TypeLits (symbolVal, KnownSymbol) import Prelude +import qualified Data.Map as Map+ -- aeson import Data.Aeson (ToJSON, FromJSON) -- bytestring@@ -107,11 +113,11 @@ -- | Smallest unit of computation in OCaml. data OCamlPrimitive- = OInt -- ^ int- | OBool -- ^ bool, boolean+ = 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+ | OInt -- ^ int | OString -- ^ string | OUnit -- ^ () | OList OCamlDatatype -- ^ 'a list, 'a Js_array.t@@ -128,7 +134,7 @@ 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}`+ | OCamlSumOfRecordConstructor Text ValueConstructor -- ^ Sum that contains at least one record. This construction is unique to Haskell. It 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.@@ -150,13 +156,15 @@ -- | Expected types of a constructor data OCamlValue = OCamlRef HaskellTypeMetaData Text -- ^ The name of a non-primitive data type+ | OCamlRefApp TypeRep OCamlValue -- ^ A type constructor that has at least one type parameter filled | 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+ | OCamlField Text OCamlValue -- ^ A field name and its type from a record.+ | Values OCamlValue OCamlValue -- ^ Used for multiple types in a NameConstructor or a RecordConstructor.+ | OCamlRefAppValues OCamlValue OCamlValue -- ^ User for multiple types in an OCamlRefApp. These are rendered in a different way from Values. deriving (Show, Eq)-+-- -- ^ ------------------------------------------------------------ -- | Create an OCaml type from a Haskell type. Use the Generic -- definition when possible. It also expects `ToJSON` and `FromJSON`@@ -209,8 +217,6 @@ then transformToSumOfRecord (T.pack (datatypeName datatype)) ocamlConstructor else ocamlConstructor -- ------------------------------------------------------------ class GenericValueConstructor f where genericToValueConstructor :: f a -> ValueConstructor@@ -258,18 +264,150 @@ 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+-- | Handle type parameter. There are found in the order of declaration on the right hand side of a type.+-- Reordering may be necessary for TypeParameterRefs.+instance Typeable a => GenericOCamlValue (Rec0 a) where+ genericToOCamlValue _ = typeRepToOCamlValue $ typeRep (Proxy :: Proxy a) +typeRepToOCamlValue :: TypeRep -> OCamlValue+typeRepToOCamlValue t =+ -- check if the type is a primitive+ case Map.lookup hd typeParameterRefTyConToOCamlTypeText of+ Just p -> OCamlTypeParameterRef p+ Nothing ->+ case primitiveTypeRepToOCamlPrimitive t of+ Just primitive -> OCamlPrimitiveRef primitive+ Nothing ->+ -- if it has no typeParams then it mkRef+ if length typeParams == 0+ then mkRef (tyConToHaskellTypeMetaData hd) (T.pack . show $ hd)+ else OCamlRefApp t (mkValues)+ where+ (hd, typeParams) = splitTyConApp t++ typeParameterRefs = (T.append) <$> ["a"] <*> (T.pack . show <$> ([0..5] :: [Int]))++ mkRef haskellTypeMetaData n =+ if n `elem` typeParameterRefs+ then OCamlTypeParameterRef n+ else OCamlRef haskellTypeMetaData n++ mkValues =+ if length typeParams == 0+ then OCamlEmpty+ else+ if length typeParams == 1+ then typeRepToOCamlValue $ head typeParams -- Values (typeRepToOCamlValue $ head typeParams) OCamlEmpty+ else+ if length typeParams == 2+ then OCamlRefAppValues (typeRepToOCamlValue $ head typeParams) (typeRepToOCamlValue $ head $ tail typeParams)+ else OCamlRefAppValues (typeRepToOCamlValue $ head typeParams) (foldl (\b a -> OCamlRefAppValues b (typeRepToOCamlValue a)) (typeRepToOCamlValue $ head $ tail typeParams) (tail $ tail typeParams))++primitiveTypeRepToOCamlPrimitive :: TypeRep -> Maybe OCamlPrimitive+primitiveTypeRepToOCamlPrimitive t =+ mkOCamlPrimitive $ length typeParams+ where+ (hd, typeParams) = splitTyConApp t+ mkOCamlPrimitive l+ | l == 0 = Map.lookup hd zero+ | l == 1 = one hd (typeParams !! 0)+ | l == 2 = two hd (typeParams !! 0) (typeParams !! 1)+ | l == 3 = three hd (typeParams !! 0) (typeParams !! 1) (typeParams !! 2)+ | l == 4 = four hd (typeParams !! 0) (typeParams !! 1) (typeParams !! 2) (typeParams !! 3)+ | l == 5 = five hd (typeParams !! 0) (typeParams !! 1) (typeParams !! 2) (typeParams !! 3) (typeParams !! 4)+ | l == 6 = six hd (typeParams !! 0) (typeParams !! 1) (typeParams !! 2) (typeParams !! 3) (typeParams !! 4) (typeParams !! 5)+ | otherwise = Nothing+ + zero :: Map.Map TyCon OCamlPrimitive+ zero = Map.fromList+ [ ( typeRepTyCon $ typeRep (Proxy :: Proxy Int), OInt)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Int8), OInt)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Int16), OInt)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Int32), OInt)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Int64), OInt)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Integer), OInt)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Word), OInt)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Word8), OInt)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Word16), OInt)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Word32), OInt)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Word64), OInt) + , ( typeRepTyCon $ typeRep (Proxy :: Proxy Bool), OBool)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Char), OChar)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy UTCTime), ODate)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Float), OFloat)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Double), OFloat)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Text), OString)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy ByteString), OString)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy String), OString)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy ()), OUnit)+ ]++ one :: TyCon -> TypeRep -> Maybe OCamlPrimitive+ one tyCon t0 =+ if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy []))+ then Just $ OList $ mkOCamlDatatype t0+ else+ if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy Maybe))+ then Just $ OOption $ mkOCamlDatatype t0+ else Nothing++ two :: TyCon -> TypeRep -> TypeRep -> Maybe OCamlPrimitive+ two tyCon t0 t1 =+ if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy Either))+ then Just $ OEither (mkOCamlDatatype t0) (mkOCamlDatatype t1)+ else+ if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy (,)))+ then Just $ OTuple2 (mkOCamlDatatype t0) (mkOCamlDatatype t1)+ else Nothing++ three :: TyCon -> TypeRep -> TypeRep -> TypeRep -> Maybe OCamlPrimitive+ three tyCon t0 t1 t2 =+ if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy (,,)))+ then Just $ OTuple3 (mkOCamlDatatype t0) (mkOCamlDatatype t1) (mkOCamlDatatype t2)+ else Nothing++ four :: TyCon -> TypeRep -> TypeRep -> TypeRep -> TypeRep -> Maybe OCamlPrimitive+ four tyCon t0 t1 t2 t3 =+ if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy (,,,)))+ then Just $ OTuple4 (mkOCamlDatatype t0) (mkOCamlDatatype t1) (mkOCamlDatatype t2) (mkOCamlDatatype t3)+ else Nothing++ five :: TyCon -> TypeRep -> TypeRep -> TypeRep -> TypeRep -> TypeRep -> Maybe OCamlPrimitive+ five tyCon t0 t1 t2 t3 t4 =+ if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy (,,,,)))+ then Just $ OTuple5 (mkOCamlDatatype t0) (mkOCamlDatatype t1) (mkOCamlDatatype t2) (mkOCamlDatatype t3) (mkOCamlDatatype t4)+ else Nothing++ six :: TyCon -> TypeRep -> TypeRep -> TypeRep -> TypeRep -> TypeRep -> TypeRep -> Maybe OCamlPrimitive+ six tyCon t0 t1 t2 t3 t4 t5 =+ if tyCon == (typeRepTyCon $ typeRep (Proxy :: Proxy (,,,,,)))+ then Just $ OTuple6 (mkOCamlDatatype t0) (mkOCamlDatatype t1) (mkOCamlDatatype t2) (mkOCamlDatatype t3) (mkOCamlDatatype t4) (mkOCamlDatatype t5)+ else Nothing++ typeParameterRefMap = Map.fromList+ [ ("TypeParameterRef0", toOCamlType (Proxy :: Proxy TypeParameterRef0))+ , ("TypeParameterRef1", toOCamlType (Proxy :: Proxy TypeParameterRef1))+ , ("TypeParameterRef2", toOCamlType (Proxy :: Proxy TypeParameterRef2))+ , ("TypeParameterRef3", toOCamlType (Proxy :: Proxy TypeParameterRef3))+ , ("TypeParameterRef4", toOCamlType (Proxy :: Proxy TypeParameterRef4))+ , ("TypeParameterRef5", toOCamlType (Proxy :: Proxy TypeParameterRef5))+ ]++ mkOCamlDatatype x =+ case primitiveTypeRepToOCamlPrimitive x of+ Just primitive -> OCamlPrimitive primitive+ Nothing ->+ case Map.lookup aTyConName typeParameterRefMap of+ Just tref -> tref+ Nothing ->+ OCamlDatatype+ (tyConToHaskellTypeMetaData tyc)+ aTyConName+ (OCamlValueConstructor . NamedConstructor aTyConName $ typeRepToOCamlValue x)+ where+ tyc = typeRepTyCon x+ aTyConName = T.pack . show $ tyc+ -- OCamlType instances for primitives instance OCamlType a => OCamlType [a] where@@ -372,7 +510,6 @@ (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)@@ -381,11 +518,19 @@ -- 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+-- TimeOfDay, 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 -} +-- | for any type that does not use the same serialization as Generic Aeson+-- and has a manually written OCaml definition, should manually derive OCamlType+-- using this function for convenience.+-- +-- instance OCamlType X where+-- toOCamlType _ = typeableToOCamlType (Proxy :: Proxy X)+--+ typeableToOCamlType :: forall a. Typeable a => Proxy a -> OCamlDatatype typeableToOCamlType Proxy = OCamlDatatype@@ -495,12 +640,13 @@ isSumWithRecord :: OCamlConstructor -> Bool isSumWithRecord (OCamlValueConstructor (MultipleConstructors cs)) =- -- if there is only one constructor than it is not a SumWithRecords.+ -- if there is only one constructor then it is not a SumWithRecords. -- if there are multiple constructors and at least one is a record constructor- -- than it is a SumWithRecords+ -- then it is a SumWithRecords (\x -> length x > 1 && or x) $ isSumWithRecordsAux . OCamlValueConstructor <$> cs where isSumWithRecordsAux :: OCamlConstructor -> Bool+ isSumWithRecordsAux (OCamlValueConstructor (MultipleConstructors cs')) = or $ isSumWithRecordsAux . OCamlValueConstructor <$> cs' isSumWithRecordsAux (OCamlValueConstructor (RecordConstructor _ _)) = True isSumWithRecordsAux _ = False isSumWithRecord _ = False@@ -515,6 +661,7 @@ match value = case value of+ (OCamlRefApp typRep _) -> getTypeParameterRefNameForTypeRep typRep (OCamlTypeParameterRef name) -> [name] (Values v1 v2) -> match v1 ++ match v2 (OCamlField _ v1) -> match v1@@ -533,7 +680,7 @@ getOCamlValues (RecordConstructor _ value) = [value] getOCamlValues (MultipleConstructors cs) = concat $ getOCamlValues <$> cs --- | getTypePar+-- | get all of the type parameters from an OCamlConstructor. getTypeParameters :: OCamlConstructor -> [Text] getTypeParameters (OCamlValueConstructor vc) = getTypeParameterRefNames . getOCamlValues $ vc getTypeParameters (OCamlSumOfRecordConstructor _ vc) = getTypeParameterRefNames . getOCamlValues $ vc@@ -545,6 +692,21 @@ isTypeParameterRef (OCamlDatatype _ _ (OCamlValueConstructor (NamedConstructor _ (OCamlTypeParameterRef _)))) = True isTypeParameterRef _ = False +-- | When there is a record that has its type parameters partially filled, it will should have TypeParameterRef0-5 as the+-- unfilled type parameters. This function properly pushes the TypeParameterRef0-5 to the type signature of an OCaml+-- type.+getTypeParameterRefNameForTypeRep :: TypeRep -> [Text]+getTypeParameterRefNameForTypeRep t =+ if length rst == 0+ then typeParamterRefText+ else typeParamterRefText <> concat (getTypeParameterRefNameForTypeRep <$> rst)+ where+ (hd,rst) = splitTyConApp $ t+ typeParamterRefText =+ case Map.lookup hd typeParameterRefTyConToOCamlTypeText of+ Just typeParamterRefText' -> [typeParamterRefText']+ Nothing -> []+ -- | 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) =@@ -573,3 +735,119 @@ oCamlValueIsFloat :: OCamlValue -> Bool oCamlValueIsFloat (OCamlPrimitiveRef OFloat) = True oCamlValueIsFloat _ = False+++-- Typeable related functions+-- when a row is a type with type parameters and those type parameters are filled,+-- we need a way to extract what those type parameters are. This is not possible with+-- Generics, but it can be done with Typeable.++-- | match type parameter reference 'TyCon's (accessible from a TypeRep) to their equivalent OCaml types.+typeParameterRefTyConToOCamlTypeText :: Map.Map TyCon Text+typeParameterRefTyConToOCamlTypeText = Map.fromList+ [ ( typeRepTyCon $ typeRep (Proxy :: Proxy TypeParameterRef0), "a0")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy TypeParameterRef1), "a1")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy TypeParameterRef2), "a2")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy TypeParameterRef3), "a3")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy TypeParameterRef4), "a4")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy TypeParameterRef5), "a5")+ ]++-- | convert TypeRep to HaskellTypeMetaData+typeRepToHaskellTypeMetaData :: TypeRep -> HaskellTypeMetaData+typeRepToHaskellTypeMetaData = tyConToHaskellTypeMetaData . typeRepTyCon++-- | convert TyCon to HaskellTypeMetaData+tyConToHaskellTypeMetaData :: TyCon -> HaskellTypeMetaData+tyConToHaskellTypeMetaData aTypeCon =+ HaskellTypeMetaData+ (T.pack . tyConName $ aTypeCon)+ (T.pack . tyConModule $ aTypeCon)+ (T.pack . tyConPackage $ aTypeCon)++{-+-- | match 'TyCon's (accessible from a TypeRep) to their equivalent OCaml types.+primitiveTyConToOCamlTypeText :: Map.Map TyCon Text+primitiveTyConToOCamlTypeText = Map.fromList+ [ ( typeRepTyCon $ typeRep (Proxy :: Proxy [] ), "list")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Maybe ), "option")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Either ), "either")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy () ), "unit")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Text ), "string")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy ByteString), "string")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Day ), "Js_date.t")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy UTCTime ), "Js_date.t")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Float ), "float")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Double ), "float")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Int8 ), "int")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Int16 ), "int")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Int32 ), "int")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Int64 ), "int")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Int ), "int")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Integer ), "int")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Word ), "int")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Word8 ), "int")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Word16 ), "int")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Word32 ), "int")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Word64 ), "int")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Char ), "string")+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy Bool ), "boolean")+ ]++-- | convert a TyCon of a tuple to its size+tupleTyConToSize :: Map.Map TyCon Int+tupleTyConToSize = Map.fromList+ [ ( typeRepTyCon $ typeRep (Proxy :: Proxy (,) ), 2)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy (,,) ), 3)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy (,,,) ), 4)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy (,,,,) ), 5)+ , ( typeRepTyCon $ typeRep (Proxy :: Proxy (,,,,,) ), 6)+ ]++-- | necessary because the TypeRep for 'String' is '([], [Char])', but we want+-- it to be reduced to an OCaml 'string'.+typeRepIsString :: TypeRep -> Bool+typeRepIsString t =+ let (hd, rst) = splitTyConApp t in+ show hd == "[]" && length rst == 1 && ((show $ head rst) == "Char")++typeParameterToRef :: Map.Map TypeRep Text+typeParameterToRef = Map.fromList+ [ ( typeRep (Proxy :: Proxy TypeParameterRef0), "a0")+ , ( typeRep (Proxy :: Proxy TypeParameterRef1), "a1")+ , ( typeRep (Proxy :: Proxy TypeParameterRef2), "a2")+ , ( typeRep (Proxy :: Proxy TypeParameterRef3), "a3")+ , ( typeRep (Proxy :: Proxy TypeParameterRef4), "a4")+ , ( typeRep (Proxy :: Proxy TypeParameterRef5), "a5")+ ]++ocamlDatatypeHasTypeParameter :: OCamlDatatype -> Int -> Bool+ocamlDatatypeHasTypeParameter ocamlDatatype index = ocamlDatatypeHasTypeParameter' ocamlDatatype+ where+ typeParameter = OCamlTypeParameterRef $ "a" <> (T.pack . show $ index)+ + ocamlDatatypeHasTypeParameter' :: OCamlDatatype -> Bool+ ocamlDatatypeHasTypeParameter' (OCamlDatatype _ _ ocamlConstructor) = ocamlConstructorHasTypeParameter ocamlConstructor+ ocamlDatatypeHasTypeParameter' (OCamlPrimitive ocamlPrimitive) = ocamlPrimitiveHasTypeParameter ocamlPrimitive++ ocamlPrimitiveHasTypeParameter :: OCamlPrimitive -> Bool+ ocamlPrimitiveHasTypeParameter (OList d0) = ocamlDatatypeHasTypeParameter' d0+ ocamlPrimitiveHasTypeParameter _ = False++ ocamlConstructorHasTypeParameter :: OCamlConstructor -> Bool+ ocamlConstructorHasTypeParameter (OCamlValueConstructor valueConstructor) = valueConstructorHasTypeParameter valueConstructor+ ocamlConstructorHasTypeParameter (OCamlSumOfRecordConstructor _ valueConstructor) = valueConstructorHasTypeParameter valueConstructor+ ocamlConstructorHasTypeParameter _ = False++ valueConstructorHasTypeParameter :: ValueConstructor -> Bool+ valueConstructorHasTypeParameter (NamedConstructor _ ocamlValue) = ocamlValueHasTypeParameter ocamlValue+ valueConstructorHasTypeParameter (RecordConstructor _ ocamlValue) = ocamlValueHasTypeParameter ocamlValue+ valueConstructorHasTypeParameter (MultipleConstructors ocamlValues) = or $ valueConstructorHasTypeParameter <$> ocamlValues++ ocamlValueHasTypeParameter :: OCamlValue -> Bool+ ocamlValueHasTypeParameter (OCamlPrimitiveRef ocamlPrimitive) = ocamlPrimitiveHasTypeParameter ocamlPrimitive+ ocamlValueHasTypeParameter o@(OCamlTypeParameterRef _) = o == typeParameter+ ocamlValueHasTypeParameter (OCamlField _ v) = ocamlValueHasTypeParameter v+ ocamlValueHasTypeParameter (Values v0 v1) = ocamlValueHasTypeParameter v0 || ocamlValueHasTypeParameter v1+ ocamlValueHasTypeParameter _ = False+-}
src/OCaml/Internal/Common.hs view
@@ -158,5 +158,12 @@ then ["("] <> (L.intersperse ", " ds) <> [")"] else ds +mkDocListP :: [Doc] -> Doc+mkDocListP ds =+ foldl (<>) "" $+ if length ds > 0+ then ["("] <> (L.intersperse ", " ds) <> [")"]+ else ds+ foldMod :: [Text] -> Text foldMod = T.intercalate "."
test/FileApp.hs view
@@ -24,9 +24,9 @@ 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+ describe "OCaml Declaration with Interface: Product Types" $ compareInterfaceFiles "File"
test/Product.hs view
@@ -9,6 +9,7 @@ module Product where -- base+import Data.Typeable import GHC.Generics -- time import Data.Time@@ -36,14 +37,30 @@ :<|> OCamlModule '["ThreeTypeParameters"] :> Three TypeParameterRef0 TypeParameterRef1 TypeParameterRef2 :<|> OCamlModule '["SubTypeParameter"] :> SubTypeParameter TypeParameterRef0 TypeParameterRef1 TypeParameterRef2 :<|> OCamlModule '["UnnamedProduct"] :> UnnamedProduct- :<|> OCamlModule '["ComplexProduct"] :> OCamlTypeInFile Simple "test/ocaml/Simple" :> ComplexProduct)+ :<|> OCamlModule '["ComplexProduct"] :> OCamlTypeInFile Simple "test/ocaml/Simple" :> ComplexProduct+ :<|> OCamlModule '["Wrapper"]+ :> Wrapper TypeParameterRef0+ :> IntWrapped+ :> MaybeWrapped+ :> EitherWrapped+ :> ComplexWrapped+ :> SumWrapped+ :> TupleWrapped+ :> HalfWrapped TypeParameterRef0+ :> PartiallyWrapped TypeParameterRef0 TypeParameterRef1 TypeParameterRef2+ :> ScrambledTypeParameterRefs TypeParameterRef0 TypeParameterRef1 TypeParameterRef2 TypeParameterRef3 TypeParameterRef4 TypeParameterRef5+ :> WrappedWrapper+ :> WrapThree TypeParameterRef0 TypeParameterRef1 TypeParameterRef2+ :> WrapThreeUnfilled TypeParameterRef0 TypeParameterRef1 TypeParameterRef2+ :> WrapThreeFilled+ :> WrapThreePartiallyFilled TypeParameterRef0+-- :> TypeSynonymKey TypeParameterRef0+-- :> NewTypeKey TypeParameterRef0 + ) compareInterfaceFiles :: FilePath -> SpecWith () compareInterfaceFiles = compareFiles "test/interface" "product" True -compareNoInterfaceFiles :: FilePath -> SpecWith ()-compareNoInterfaceFiles = compareFiles "test/nointerface" "product" False- data SimpleChoice = SimpleChoice { choice :: Either String Int@@ -115,25 +132,30 @@ OneTypeParameter { otpId :: Int , otpFirst :: a- } deriving (Eq,Show,Generic,OCamlType,FromJSON,ToJSON)+ } deriving (Eq,Show,Generic,FromJSON,ToJSON) instance Arbitrary (OneTypeParameter TypeParameterRef0) where arbitrary = OneTypeParameter <$> arbitrary <*> arbitrary instance ToADTArbitrary (OneTypeParameter TypeParameterRef0) +instance (Typeable a, OCamlType a) => (OCamlType (OneTypeParameter a))+ data TwoTypeParameters a b = TwoTypeParameters { ttpId :: Int , ttpFirst :: a , ttpSecond :: b- } deriving (Eq,Show,Generic,OCamlType,FromJSON,ToJSON)+ , ttpThird :: (a, b)+ } deriving (Eq,Show,Generic,FromJSON,ToJSON) instance Arbitrary (TwoTypeParameters TypeParameterRef0 TypeParameterRef1) where- arbitrary = TwoTypeParameters <$> arbitrary <*> arbitrary <*> arbitrary+ arbitrary = TwoTypeParameters <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance ToADTArbitrary (TwoTypeParameters TypeParameterRef0 TypeParameterRef1) +instance (Typeable a, OCamlType a, Typeable b, OCamlType b) => (OCamlType (TwoTypeParameters a b))+ data Three a b c = Three { threeId :: Int@@ -141,19 +163,21 @@ , threeSecond :: b , threeThird :: c , threeString :: String- } deriving (Eq,Show,Generic,OCamlType,FromJSON,ToJSON)+ } deriving (Eq,Show,Generic,FromJSON,ToJSON) instance Arbitrary (Three TypeParameterRef0 TypeParameterRef1 TypeParameterRef2) where arbitrary = Three <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance ToADTArbitrary (Three TypeParameterRef0 TypeParameterRef1 TypeParameterRef2) +instance (Typeable a, OCamlType a, Typeable b, OCamlType b, Typeable c, OCamlType c) => (OCamlType (Three a b c))+ data SubTypeParameter a b c = SubTypeParameter { listA :: [a] , maybeB :: Maybe b , tupleC :: (c,b)- } deriving (Eq,Show,Generic,OCamlType,FromJSON,ToJSON)+ } deriving (Eq,Show,Generic,FromJSON,ToJSON) instance Arbitrary (SubTypeParameter TypeParameterRef0 TypeParameterRef1 TypeParameterRef2) where arbitrary = do@@ -163,6 +187,8 @@ instance ToADTArbitrary (SubTypeParameter TypeParameterRef0 TypeParameterRef1 TypeParameterRef2) +instance (Typeable a, OCamlType a, Typeable b, OCamlType b, Typeable c, OCamlType c) => (OCamlType (SubTypeParameter a b c))+ data UnnamedProduct = UnnamedProduct String Int deriving (Eq, Read, Show, Generic, OCamlType, FromJSON, ToJSON) @@ -204,3 +230,205 @@ ComplexProduct <$> arbitrary <*> pure v0 <*> pure v1 <*> arbitrary <*> arbitrary instance ToADTArbitrary ComplexProduct++data Wrapper a =+ Wrapper+ { wpa :: a+ } deriving (Eq,Show,Generic,ToJSON,FromJSON)++instance (ToADTArbitrary a, Arbitrary a) => ToADTArbitrary (Wrapper a)+instance (Arbitrary a) => Arbitrary (Wrapper a) where+ arbitrary = Wrapper <$> arbitrary+instance (Typeable a, OCamlType a) => (OCamlType (Wrapper a))++data IntWrapped =+ IntWrapped+ { iw :: Wrapper Int+ } deriving (Eq,Show,Generic,OCamlType,ToJSON,FromJSON)++instance ToADTArbitrary IntWrapped+instance Arbitrary IntWrapped where+ arbitrary = IntWrapped <$> arbitrary++data MaybeWrapped =+ MaybeWrapped+ { mw :: Wrapper (Maybe Int)+ } deriving (Eq,Show,Generic,OCamlType,ToJSON,FromJSON)++instance ToADTArbitrary MaybeWrapped+instance Arbitrary MaybeWrapped where+ arbitrary = MaybeWrapped <$> arbitrary++data EitherWrapped =+ EitherWrapped+ { ew :: Wrapper (Either Int Double)+ } deriving (Eq,Show,Generic,OCamlType,ToJSON,FromJSON)++instance ToADTArbitrary EitherWrapped+instance Arbitrary EitherWrapped where+ arbitrary = EitherWrapped <$> arbitrary++data ComplexWrapped =+ ComplexWrapped+ { cw :: Wrapper (Either (Maybe Char) Double)+ } deriving (Eq,Show,Generic,OCamlType,ToJSON,FromJSON)++instance ToADTArbitrary ComplexWrapped+instance Arbitrary ComplexWrapped where+ arbitrary = ComplexWrapped <$> arbitrary++data TupleWrapped =+ TupleWrapped+ { tw :: Wrapper (Int,String,Double)+ } deriving (Eq,Show,Generic,OCamlType,ToJSON,FromJSON)++instance ToADTArbitrary TupleWrapped+instance Arbitrary TupleWrapped where+ arbitrary = TupleWrapped <$> arbitrary++data SumWrapped+ = SW1+ | SW2 (Wrapper Int)+ | SW3 (Wrapper (Maybe String))+ | SW4 (Wrapper (Either Int String))+ deriving (Eq,Show,Generic,OCamlType,ToJSON,FromJSON)++instance ToADTArbitrary SumWrapped+instance Arbitrary SumWrapped where+ arbitrary =+ oneof+ [ pure SW1+ , SW2 <$> arbitrary+ , SW3 <$> arbitrary+ , SW4 <$> arbitrary+ ]++data HalfWrapped a =+ HalfWrapped+ { hw :: Wrapper (Either Int a)+ } deriving (Eq,Show,Generic,ToJSON,FromJSON)++instance Arbitrary (HalfWrapped TypeParameterRef0) where+ arbitrary = HalfWrapped <$> arbitrary++instance ToADTArbitrary (HalfWrapped TypeParameterRef0)++instance (Typeable a, OCamlType a) => (OCamlType (HalfWrapped a))++data PartiallyWrapped a b c =+ PartiallyWrapped+ { pw :: Wrapper (Either Int (String,b,Double,c,a))+ } deriving (Eq,Show,Generic,ToJSON,FromJSON)++instance Arbitrary (PartiallyWrapped TypeParameterRef0 TypeParameterRef1 TypeParameterRef2) where+ arbitrary = PartiallyWrapped <$> arbitrary++instance ToADTArbitrary (PartiallyWrapped TypeParameterRef0 TypeParameterRef1 TypeParameterRef2)++instance (Typeable a, OCamlType a, Typeable b, OCamlType b, Typeable c, OCamlType c) => (OCamlType (PartiallyWrapped a b c))++-- | type parameter declaration and use order are different+data ScrambledTypeParameterRefs a b c d e f =+ ScrambledTypeParameterRefs+ { stprb :: b+ , stprd :: d+ , stpre :: e+ , stpra :: a+ , stprf :: f+ , stprc :: c+ } deriving (Eq,Show,Generic,ToJSON,FromJSON)++instance Arbitrary (ScrambledTypeParameterRefs TypeParameterRef0 TypeParameterRef1 TypeParameterRef2 TypeParameterRef3 TypeParameterRef4 TypeParameterRef5) where+ arbitrary = ScrambledTypeParameterRefs <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++instance ToADTArbitrary (ScrambledTypeParameterRefs TypeParameterRef0 TypeParameterRef1 TypeParameterRef2 TypeParameterRef3 TypeParameterRef4 TypeParameterRef5)++instance (Typeable a, OCamlType a, Typeable b, OCamlType b, Typeable c, OCamlType c, Typeable d, OCamlType d, Typeable e, OCamlType e, Typeable f, OCamlType f) => (OCamlType (ScrambledTypeParameterRefs a b c d e f))++data WrappedWrapper =+ WrappedWrapper+-- { ww :: Maybe (Wrapper (Maybe String))+ { ww :: Maybe (Wrapper (Maybe Int))+ } deriving (Eq,Show,Generic,ToJSON,FromJSON,OCamlType)++instance Arbitrary WrappedWrapper where+ arbitrary = WrappedWrapper <$> arbitrary++instance ToADTArbitrary WrappedWrapper++data WrapThree a b c =+ WrapThree+ { wp2a :: a+ , wp2b :: b+ , wp2ab :: (a, b)+ , wp2cb :: (c, b)+ } deriving (Eq,Show,Generic,ToJSON,FromJSON)++instance (ToADTArbitrary a, Arbitrary a, ToADTArbitrary b, Arbitrary b, ToADTArbitrary c, Arbitrary c) => ToADTArbitrary (WrapThree a b c)+instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (WrapThree a b c) where+ arbitrary = WrapThree <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+instance (Typeable a, OCamlType a, Typeable b, OCamlType b, Typeable c, OCamlType c) => (OCamlType (WrapThree a b c))++data WrapThreeUnfilled a b c =+ WrapThreeUnfilled+ { zed :: String+ , unfilled :: WrapThree a b c+ } deriving (Eq,Show,Generic,ToJSON,FromJSON)++instance (ToADTArbitrary a, Arbitrary a, ToADTArbitrary b, Arbitrary b, ToADTArbitrary c, Arbitrary c) => ToADTArbitrary (WrapThreeUnfilled a b c)+instance (Arbitrary a, Arbitrary b, Arbitrary c) => Arbitrary (WrapThreeUnfilled a b c) where+ arbitrary = WrapThreeUnfilled <$> arbitrary <*> arbitrary+instance (Typeable a, OCamlType a, Typeable b, OCamlType b, Typeable c, OCamlType c) => (OCamlType (WrapThreeUnfilled a b c))++data WrapThreeFilled =+ WrapThreeFilled+ { foo :: String+ , filled :: WrapThree Int Double Person+ } deriving (Eq,Show,Generic,ToJSON,FromJSON)++instance ToADTArbitrary WrapThreeFilled+instance Arbitrary WrapThreeFilled where+ arbitrary = WrapThreeFilled <$> arbitrary <*> arbitrary+instance OCamlType WrapThreeFilled++data WrapThreePartiallyFilled a =+ WrapThreePartiallyFilled+ { bar :: String+ , bar2 :: [Int]+ , partiallyFilled :: WrapThree Float a Double+ } deriving (Eq,Show,Generic,ToJSON,FromJSON)++instance (ToADTArbitrary a, Arbitrary a) => ToADTArbitrary (WrapThreePartiallyFilled a)+instance Arbitrary a => Arbitrary (WrapThreePartiallyFilled a) where+ arbitrary = WrapThreePartiallyFilled <$> arbitrary <*> arbitrary <*> arbitrary+instance (Typeable a, OCamlType a) => OCamlType (WrapThreePartiallyFilled a)++-- phantom types++data TypeSynonymKey a = String+ deriving (Eq,Show,Generic,ToJSON,FromJSON)++instance (ToADTArbitrary a, Arbitrary a) => ToADTArbitrary (TypeSynonymKey a)+instance Arbitrary a => Arbitrary (TypeSynonymKey a) where+ arbitrary = arbitrary+instance (Typeable a, OCamlType a) => OCamlType (TypeSynonymKey a)++newtype NewTypeKey a = NewTypeKey String+ deriving (Eq,Show,Generic,ToJSON,FromJSON)++instance (ToADTArbitrary a, Arbitrary a) => ToADTArbitrary (NewTypeKey a)+instance Arbitrary a => Arbitrary (NewTypeKey a) where+ arbitrary = NewTypeKey <$> arbitrary+instance (Typeable a, OCamlType a) => OCamlType (NewTypeKey a)+++{-+λ> toOCamlType (Proxy :: Proxy (Key User))+OCamlDatatype (HaskellTypeMetaData "Key" "Database.Persist.Class.PersistEntity" "persistent-2.6-HdpHylIi1gZ4QjAhgpXd6i") "Key" (OCamlValueConstructor (NamedConstructor "Key" OCamlEmpty))+λ+++λ> toOCamlType (Proxy :: Proxy (UserTag))+OCamlDatatype (HaskellTypeMetaData "UserTag" "Onping.Persist.Models.Internal" "onping-types-0.12.0.0-537fBzusEVB7hcaZbAcQql") "UserTag" (OCamlValueConstructor (RecordConstructor "UserTag" (Values (Values (Values (OCamlField "userTagUser" (OCamlRefApp (Key User) (OCamlRef (HaskellTypeMetaData "User" "Plowtech.Authentication.Persist.Models" "plowtech-authentication-types-0.3.0.0-HOAisznLARVIB1OtLfSJK3") "User"))) (OCamlField "userTagOwner" (OCamlRefApp (Key User) (OCamlRef (HaskellTypeMetaData "User" "Plowtech.Authentication.Persist.Models" "plowtech-authentication-types-0.3.0.0-HOAisznLARVIB1OtLfSJK3") "User")))) (Values (OCamlField "userTagGroup" (OCamlRefApp (Key Group) (OCamlRef (HaskellTypeMetaData "Group" "Onping.Persist.Models.Internal" "onping-types-0.12.0.0-537fBzusEVB7hcaZbAcQql") "Group"))) (Values (OCamlField "userTagSuperGroup" (OCamlRefApp (Key Group) (OCamlRef (HaskellTypeMetaData "Group" "Onping.Persist.Models.Internal" "onping-types-0.12.0.0-537fBzusEVB7hcaZbAcQql") "Group"))) (OCamlField "userTagDefaultDash" (OCamlRefApp (Key Dashboard) (OCamlRef (HaskellTypeMetaData "Dashboard" "Onping.Persist.Models.Internal" "onping-types-0.12.0.0-537fBzusEVB7hcaZbAcQql") "Dashboard")))))) (Values (Values (OCamlField "userTagPhone" (OCamlPrimitiveRef (OOption (OCamlPrimitive OInt)))) (OCamlField "userTagName" (OCamlPrimitiveRef (OOption (OCamlPrimitive OString))))) (Values (OCamlField "userTagCallAlert" (OCamlPrimitiveRef OBool)) (Values (OCamlField "userTagEmailAlert" (OCamlPrimitiveRef OBool)) (OCamlField "userTagTextAlert" (OCamlPrimitiveRef OBool))))))))++-}
test/ProductApp.hs view
@@ -31,15 +31,4 @@ compareInterfaceFiles "SubTypeParameter" compareInterfaceFiles "UnnamedProduct" compareInterfaceFiles "ComplexProduct"- - let dir2 = "test/nointerface/temp"- runIO $ mkPackage (Proxy :: Proxy ProductPackage) (PackageOptions dir2 "product" fileMap False Nothing)-- describe "OCaml Declaration without Interface: Product Types" $ do- compareNoInterfaceFiles "Person"- compareNoInterfaceFiles "Company"- compareNoInterfaceFiles "Card"- compareNoInterfaceFiles "OneTypeParameter"- compareNoInterfaceFiles "TwoTypeParameters"- compareNoInterfaceFiles "ThreeTypeParameters"- compareNoInterfaceFiles "SubTypeParameter"+ compareInterfaceFiles "Wrapper"
test/Spec.hs view
@@ -35,8 +35,7 @@ (mkOCamlTypeMetaData (Proxy :: Proxy Product.ProductPackage)) <> (mkOCamlTypeMetaData (Proxy :: Proxy D.DependencyPackageWithoutProduct)) `shouldBe` mkOCamlTypeMetaData (Proxy :: Proxy D.DependencyPackage) - print $ mkOCamlTypeMetaData (Proxy :: Proxy D.SubsPackage)- _ <- forkIO $ run 8081 Product.productPackageApp _ <- forkIO $ run 8082 sumPackageApp run 8083 File.filePackageApp+ pure ()
test/Sum.hs view
@@ -10,7 +10,7 @@ -- base import GHC.Generics-+import Data.Typeable -- aeson import Data.Aeson (FromJSON, ToJSON) @@ -30,9 +30,6 @@ -- servant import Servant.API --- servant-server-import Servant- -- ocaml-export import OCaml.Export hiding (mkGoldenFiles) import Util@@ -44,8 +41,8 @@ :<|> OCamlModule '["NameOrIdNumber"] :> NameOrIdNumber :<|> OCamlModule '["SumVariant"] :> SumVariant :<|> OCamlModule '["WithTuple"] :> WithTuple- :<|> OCamlModule '["SumWithRecord"] :> SumWithRecord- :<|> OCamlModule '["Result"] :> Result TypeParameterRef0 TypeParameterRef1+ :<|> OCamlModule '["SumWithRecord"] :> SumWithRecord -- :> SumWithRecordMixed+ :<|> OCamlModule '["Result"] :> Result TypeParameterRef0 TypeParameterRef1 -- :> ComplexResult TypeParameterRef0 TypeParameterRef1 TypeParameterRef2 :<|> OCamlModule '["NewType"] :> NewType) compareInterfaceFiles :: FilePath -> SpecWith ()@@ -81,19 +78,6 @@ 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)@@ -114,13 +98,39 @@ data Result a b = Success a | Error b- deriving (Show, Eq, Generic, OCamlType, ToJSON, FromJSON)+ deriving (Show, Eq, Generic, ToJSON, FromJSON) instance Arbitrary (Result TypeParameterRef0 TypeParameterRef1) where arbitrary = oneof [Success <$> arbitrary, Error <$> arbitrary] instance ToADTArbitrary (Result TypeParameterRef0 TypeParameterRef1) +instance (Typeable a, OCamlType a, Typeable b, OCamlType b) => (OCamlType (Result a b))++data ComplexResult a b c+ = CR0 a+ | CR1 a b+ | CR2 b (c,a)+ | CR3 String b Int a+ | CR4 { cr4b :: b, cr4ac :: (a,c) }+ | CR5+ deriving (Show, Eq, Generic, ToJSON, FromJSON)++instance Arbitrary (ComplexResult TypeParameterRef0 TypeParameterRef1 TypeParameterRef2) where+ arbitrary =+ oneof+ [ CR0 <$> arbitrary+ , CR1 <$> arbitrary <*> arbitrary+ , CR2 <$> arbitrary <*> arbitrary+ , CR3 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+ , CR4 <$> arbitrary <*> arbitrary+ , pure CR5+ ]++instance ToADTArbitrary (ComplexResult TypeParameterRef0 TypeParameterRef1 TypeParameterRef2)++instance (Typeable a, OCamlType a, Typeable b, OCamlType b, Typeable c, OCamlType c) => (OCamlType (ComplexResult a b c))+ data SumVariant = HasNothing | HasSingleInt Int@@ -169,6 +179,25 @@ instance ToADTArbitrary SumWithRecord +data SumWithRecordMixed+ = SRM1 {srm1 :: Int}+ | SRM2+ | SRM3 {srm2 :: String, srm3 :: Float}+ | SRM4 Int (String, Double)+ deriving (Show,Eq,Generic, OCamlType, ToJSON, FromJSON)++instance Arbitrary SumWithRecordMixed where+ arbitrary =+ oneof+ [ SRM1 <$> arbitrary+ , pure SRM2+ , SRM3 <$> arbitrary <*> arbitrary+ , SRM4 <$> arbitrary <*> arbitrary+ ]++instance ToADTArbitrary SumWithRecordMixed++ newtype NewType = NewType Int deriving (Show,Eq,Generic,OCamlType, ToJSON, FromJSON)@@ -177,3 +206,22 @@ arbitrary = NewType <$> arbitrary instance ToADTArbitrary NewType+++{-+introduce Enumerator+extra type is made+but anything coming after the enumerator is broken+++++λ> toOCamlType (Proxy :: Proxy (ComplexResult TypeParameterRef0 TypeParameterRef1 TypeParameterRef2))++OCamlDatatype (HaskellTypeMetaData "ComplexResult" "Sum" "main") "ComplexResult" (OCamlValueConstructor (MultipleConstructors [MultipleConstructors [NamedConstructor "CR0" (OCamlTypeParameterRef "a0"),MultipleConstructors [NamedConstructor "CR1" (Values (OCamlTypeParameterRef "a0") (OCamlTypeParameterRef "a1")),NamedConstructor "CR2" (Values (OCamlTypeParameterRef "a1") (OCamlPrimitiveRef (OTuple2 (OCamlDatatype (HaskellTypeMetaData "a2" "OCaml.BuckleScript.Types" "ocaml-export") "a2" (OCamlValueConstructor (NamedConstructor "a2" (OCamlTypeParameterRef "a2")))) (OCamlDatatype (HaskellTypeMetaData "a0" "OCaml.BuckleScript.Types" "ocaml-export") "a0" (OCamlValueConstructor (NamedConstructor "a0" (OCamlTypeParameterRef "a0")))))))]],MultipleConstructors [NamedConstructor "CR3" (Values (Values (OCamlPrimitiveRef (OList (OCamlPrimitive OChar))) (OCamlTypeParameterRef "a1")) (Values (OCamlPrimitiveRef OInt) (OCamlTypeParameterRef "a0"))),MultipleConstructors [RecordConstructor "CR4" (Values (OCamlField "cr4b" (OCamlTypeParameterRef "a1")) (OCamlField "cr4ac" (OCamlPrimitiveRef (OTuple2 (OCamlDatatype (HaskellTypeMetaData "a0" "OCaml.BuckleScript.Types" "ocaml-export") "a0" (OCamlValueConstructor (NamedConstructor "a0" (OCamlTypeParameterRef "a0")))) (OCamlDatatype (HaskellTypeMetaData "a2" "OCaml.BuckleScript.Types" "ocaml-export") "a2" (OCamlValueConstructor (NamedConstructor "a2" (OCamlTypeParameterRef "a2")))))))),NamedConstructor "CR5" OCamlEmpty]]]))++λ> toOCamlType (Proxy :: Proxy SumWithRecord)++OCamlDatatype (HaskellTypeMetaData "SumWithRecord" "Sum" "main") "SumWithRecord" (OCamlSumOfRecordConstructor "SumWithRecord" (MultipleConstructors [RecordConstructor "A1" (OCamlField "a1" (OCamlPrimitiveRef OInt)),RecordConstructor "B2" (Values (OCamlField "b2" (OCamlPrimitiveRef (OList (OCamlPrimitive OChar)))) (OCamlField "b3" (OCamlPrimitiveRef OInt)))]))++-}