ocaml-export 0.9.0.0 → 0.13.0
raw patch · 12 files changed
+357/−49 lines, 12 files
Files
- ocaml-export.cabal +4/−4
- src/OCaml/BuckleScript/Decode.hs +63/−12
- src/OCaml/BuckleScript/Encode.hs +19/−9
- src/OCaml/BuckleScript/Internal/Module.hs +8/−2
- src/OCaml/BuckleScript/Record.hs +7/−5
- src/OCaml/BuckleScript/Spec.hs +2/−2
- src/OCaml/BuckleScript/Types.hs +6/−6
- src/OCaml/Export.hs +6/−6
- src/OCaml/Internal/Common.hs +3/−2
- test/Product.hs +235/−1
- test/ProductApp.hs +2/−0
- test/Sum.hs +2/−0
ocaml-export.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 8c174c8aea9f9e12c093c4b32df7c7d3734d09caa318020132493d136120bb26+-- hash: 52500c9ae7641ae8c64abb0416c86e1974040bf8afa8c8d23717b0f60d4a6317 name: ocaml-export-version: 0.9.0.0+version: 0.13.0 synopsis: Convert Haskell types in OCaml types description: Use GHC.Generics and Typeable to convert Haskell types to OCaml types. Convert aeson serialization to ocaml. category: Web@@ -31,7 +31,7 @@ library hs-source-dirs: src- ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wredundant-constraints -fprint-potential-instances+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wredundant-constraints -fprint-potential-instances build-depends: QuickCheck , aeson@@ -74,7 +74,7 @@ main-is: Spec.hs hs-source-dirs: test- ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-depends: QuickCheck , aeson
src/OCaml/BuckleScript/Decode.hs view
@@ -23,7 +23,7 @@ import Control.Monad.Reader import qualified Data.List as L import Data.Maybe (catMaybes)-import Data.Monoid+import Data.Monoid ((<>)) import Data.Proxy (Proxy (..)) import Data.Typeable -- aeson@@ -34,7 +34,8 @@ import Data.Text (Text) import qualified Data.Text as T -- wl-pprint-import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>))+import Text.PrettyPrint.Leijen.Text+ (Doc, (<+>), (<$$>), comma, dquotes, empty, indent, int, line, parens) -- ocaml-export import OCaml.BuckleScript.Types hiding (getOCamlValues) import OCaml.Internal.Common@@ -82,10 +83,10 @@ <$$> "val" <+> fnName <+> ":" <+> typeParameterEncoders <> "Js_json.t ->" <+> "(" <> typeParameters <> (stext . textLowercaseFirst $ typeName) <> ", string)" <+> "Belt.Result.t" - renderInterface datatype@(OCamlDatatype _ typeName constructors) = do- fnName <- renderRef datatype+ 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)" <+> "Belt.Result.t"+ pure $ "val" <+> "decode" <> (stext typeName) <+> ":" <+> typeParameterEncoders <> "Js_json.t ->" <+> "(" <> typeParameters <> (stext . textLowercaseFirst $ typeName) <> ", string)" <+> "Belt.Result.t" renderInterface _ = pure "" @@ -132,8 +133,8 @@ = "| Some err -> Belt.Result.Error (\"" <> fnName <> ": unknown enumeration '\" ^ err ^ \"'.\")" <$$> "| None -> Belt.Result.Error \"" <> fnName <> ": expected a top-level JSON string.\"" - render datatype@(OCamlDatatype _ name constructor) = do- fnName <- renderRef datatype+ render (OCamlDatatype _ typeName constructor) = do+ let fnName = "decode" <> (stext typeName) fnBody <- render constructor ocamlInterface <- asks (includeOCamlInterface . userOptions) if ocamlInterface@@ -143,14 +144,14 @@ pure $ "let" <+> fnName <+> renderedTypeParameters <+> "json" <+> "=" <$$> fnBody else do let (typeParameterSignatures,typeParameters) = renderTypeParameters constructor- returnType = "(" <> typeParameters <> (stext . textLowercaseFirst $ name) <> ", string) Belt.Result.t ="+ returnType = "(" <> typeParameters <> (stext . textLowercaseFirst $ typeName) <> ", string) Belt.Result.t =" pure $ "let" <+> fnName <+> typeParameterSignatures <+> "(json : Js_json.t) :" <> returnType <$$> fnBody 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)+ renderRef (OCamlDatatype typeRef typeName (OCamlValueConstructor (NamedConstructor _ (OCamlRefApp typRep values)))) = do+ let name = "decode" <> (stext typeName) dx <- renderRef values mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData @@ -185,6 +186,38 @@ renderRef (OCamlPrimitive primitive) = renderRef primitive instance HasDecoder OCamlConstructor where+ render (OCamlValueConstructor (NamedConstructor name value@(OCamlRefApp _ _))) = do+ decoder <- render value+ let constructorParams = constructorParameters 0 value+ v <- mk name 0 $ (Just <$> flattenOCamlValue value) ++ [Nothing]+ pure $+ if length constructorParams > 1+ then+ indent 2 $ "match Js.Json.decodeArray json with"+ <$$> "| Some v ->"+ <$$> (indent 2 v)+ <$$> "| None -> Belt.Result.Error (\"" <> (stext name) <+> "expected an array.\")"+ else+ indent 2 $ "match (Aeson.Decode.unwrapResult (" <> decoder <+> "json))" <+> "with"+ <$$> "| v -> Belt.Result.Ok" <+> parens (stext name <+> "v")+ <$$> "| exception Aeson.Decode.DecodeError msg -> Belt.Result.Error (\"decode" <> (stext . textUppercaseFirst $ name) <> ": \" ^ msg)"++ render (OCamlValueConstructor (NamedConstructor name value@(OCamlRef _ _))) = do+ decoder <- render value+ let constructorParams = constructorParameters 0 value+ v <- mk name 0 $ (Just <$> flattenOCamlValue value) ++ [Nothing]+ pure $+ if length constructorParams > 1+ then+ indent 2 $ "match Js.Json.decodeArray json with"+ <$$> "| Some v ->"+ <$$> (indent 2 v)+ <$$> "| None -> Belt.Result.Error (\"" <> (stext name) <+> "expected an array.\")"+ else+ indent 2 $ "match (Aeson.Decode.unwrapResult (" <> decoder <+> "json))" <+> "with"+ <$$> "| v -> Belt.Result.Ok" <+> parens (stext name <+> "v")+ <$$> "| exception Aeson.Decode.DecodeError msg -> Belt.Result.Error (\"decode" <> (stext . textUppercaseFirst $ name) <> ": \" ^ msg)"+ render (OCamlValueConstructor (NamedConstructor name value)) = do decoder <- render value let constructorParams = constructorParameters 0 value@@ -270,6 +303,14 @@ dy <- render y pure $ (wrapIfPrimitive x dx) <+> (wrapIfPrimitive y dy) + renderRef (OCamlRef metadata ref) = do+ mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData+ case mOCamlTypeMetaData of+ Nothing -> fail $ "OCaml.BuckleScript.Decode (HasDecoder (OCamlRef typeRep name)) mOCamlTypeMetaData is Nothing:\n\n" ++ (show ref)+ Just ocamlTypeRef -> do+ ds <- asks (dependencies . userOptions)+ pure $ stext (appendModule' ds ocamlTypeRef metadata ref)+ renderRef (OCamlPrimitiveRef primitive) = renderRef primitive renderRef _ = pure ""@@ -474,10 +515,10 @@ case x of Nothing -> mk name i xs Just x' -> do- renderedVal <- render x'+ renderedVal <- unwrapIfTypeParameter x' <$> render x' renderedInternal <- mk name (i+1) xs let iDoc = (stext . T.pack . show $ i)- pure $ indent 1 $ "(match" <+> (if oCamlValueIsFloat x' then "" else "Aeson.Decode.") <> renderedVal <+> ("v." <> parens iDoc) <+> "with"+ pure $ indent 1 $ "(match" <+> "Aeson.Decode.(" <> renderedVal <> (") v." <> parens iDoc) <+> "with" <$$> indent 1 ("| v" <> iDoc <+> "->" <$$> (indent 2 renderedInternal)@@ -539,6 +580,16 @@ -- 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++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) <> "decode" <> (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 -> "decode" <> textUppercaseFirst name+ wrapIfPrimitive :: OCamlValue -> Doc -> Doc wrapIfPrimitive (OCamlPrimitiveRef _) doc = parens $ "wrapResult" <+> doc
src/OCaml/BuckleScript/Encode.hs view
@@ -23,7 +23,7 @@ import Control.Monad.Reader import qualified Data.List as L import Data.Maybe (catMaybes)-import Data.Monoid+import Data.Monoid ((<>)) import Data.Proxy (Proxy (..)) import Data.Typeable @@ -38,7 +38,8 @@ import qualified Data.Text as T -- wl-pprint-import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>))+import Text.PrettyPrint.Leijen.Text+ (Doc, (<+>), (<$$>), comma, dquotes, empty, indent, int, nest, parens) -- ocaml-export import OCaml.BuckleScript.Types@@ -90,11 +91,11 @@ <$$> "val" <+> fnName <+> ":" <+> typeParameterSignatures <+> typeParameters <> encodeFnName <+> "->" <+> "Js_json.t" -- other data types- renderTypeInterface datatype@(OCamlDatatype _ typeName constructor) = do- fnName <- renderRef datatype+ 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"+ pure $ "val" <+> "encode" <> (stext typeName) <+> ":" <+> typeParameterSignatures <+> typeParameters <> encodeFnName <+> "->" <+> "Js_json.t" -- no need to render for primitives renderTypeInterface _ = pure ""@@ -139,9 +140,9 @@ (indent 2 ("match x with" <$$> foldl1 (<$$>) dc)) -- product or record- render datatype@(OCamlDatatype _ typeName constructor) = do+ render (OCamlDatatype _ typeName constructor) = do ocamlInterface <- asks (includeOCamlInterface . userOptions)- fnName <- renderRef datatype+ let fnName = "encode" <> (stext typeName) renderedConstructor <- render constructor if ocamlInterface then do@@ -160,8 +161,9 @@ -- | 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)+ renderRef (OCamlDatatype _ typeName (OCamlValueConstructor (NamedConstructor _ (OCamlRefApp typRep values)))) = do+ -- let name = "encode" <> (stext $ textUppercaseFirst $ T.pack $ show $ fst $ splitTyConApp typRep)+ let name = "encode" <> (stext typeName) dx <- renderRef values mOCamlTypeMetaData <- asks topLevelOCamlTypeMetaData @@ -290,6 +292,14 @@ dx <- render x dy <- render y pure $ dx <+> dy++ renderRef (OCamlRef metadata ref) = 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 metadata ref) renderRef (OCamlPrimitiveRef primitive) = renderRef primitive
src/OCaml/BuckleScript/Internal/Module.hs view
@@ -71,6 +71,7 @@ -- template-haskell import Language.Haskell.TH+import Language.Haskell.TH.Syntax (addDependentFile) -- text import Data.Text (Text)@@ -256,14 +257,19 @@ mkFiles'' _ includeInterface includeSpec Proxy = do let typeFilePath = symbolVal (Proxy :: Proxy b) let typeName = tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a)+ addDependentFile (typeFilePath <.> "ml") ml <- embedFile (typeFilePath <.> "ml") mli <- if includeInterface- then (\f -> AppE (ConE $ mkName "Just") f) <$> embedFile (typeFilePath <.> "mli")+ then do+ addDependentFile (typeFilePath <.> "mli")+ (\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")+ then do+ addDependentFile (typeFilePath <> "_spec" <.> "ml")+ (\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]]
src/OCaml/BuckleScript/Record.hs view
@@ -21,7 +21,7 @@ import Control.Monad.Reader import Data.List (nub, sort) import Data.Maybe (catMaybes)-import Data.Monoid+import Data.Monoid ((<>)) import Data.Proxy (Proxy (..)) import Data.Typeable @@ -37,7 +37,8 @@ import qualified Data.Text as T -- wl-pprint-import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>))+import Text.PrettyPrint.Leijen.Text+ (Doc, (<+>), (<$$>), comma, indent, line, parens, space) -- | Convert a 'Proxy a' into OCaml type source code. toOCamlTypeSourceWith :: forall a. OCamlType a => Options -> a -> T.Text@@ -81,9 +82,9 @@ fnBody <- render constructor pure $ "type" <+> typeParameters <+> fnName <+> "=" <$$> indent 2 fnBody - render datatype@(OCamlDatatype _ _ constructor) = do+ render (OCamlDatatype _ typeName constructor) = do let typeParameters = renderTypeParameters constructor- fnName <- renderRef datatype+ let fnName = stext . textLowercaseFirst $ typeName fnBody <- render constructor pure $ "type" <+> typeParameters <+> fnName <+> "=" <$$> indent 2 ("|" <+> fnBody) @@ -129,6 +130,7 @@ dy <- render y pure $ dx <> comma <+> dy + renderRef (OCamlRef _metaData primitive) = pure $ stext primitive renderRef (OCamlPrimitiveRef primitive) = renderRef primitive renderRef _ = pure "" @@ -175,7 +177,7 @@ Nothing -> fail $ "OCaml.BuckleScript.Record (HasType (OCamlDatatype typeRep name)) mOCamlTypeMetaData is Nothing:\n\n" Just ocamlTypeRef -> do ds <- asks (dependencies . userOptions)- dx <- renderRef values+ dx <- render values pure $ (parensIfNotBlank dx) <+> (stext $ appendModule ds ocamlTypeRef (typeRepToHaskellTypeMetaData typRep) (T.pack . show $ typeRepTyCon typRep)) render (OCamlTypeParameterRef name) = pure $ stext ("'" <> name)
src/OCaml/BuckleScript/Spec.hs view
@@ -9,7 +9,7 @@ ) where -- base-import Data.Monoid+import Data.Monoid ((<>)) -- text import Data.Text (Text) import qualified Data.Text as T@@ -17,7 +17,7 @@ import OCaml.BuckleScript.Types hiding (getOCamlValues) import OCaml.Internal.Common -- wl-pprint-import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>), (</>))+import Text.PrettyPrint.Leijen.Text (Doc, (<+>), (<$$>), dquotes, indent) mkSampleServerAndGoldenSpec :: OCamlDatatype -> Maybe Int -> [Text] -> Text -> Text -> Doc mkSampleServerAndGoldenSpec (OCamlDatatype _ typeName constructors) mParameterRefCount modules url goldenDir =
src/OCaml/BuckleScript/Types.hs view
@@ -37,12 +37,12 @@ -- 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+ , TypeParameterRef0(..)+ , TypeParameterRef1(..)+ , TypeParameterRef2(..)+ , TypeParameterRef3(..)+ , TypeParameterRef4(..)+ , TypeParameterRef5(..) -- functions for manipulating and querying the data type tree , getTypeParameterRefNames
src/OCaml/Export.hs view
@@ -30,12 +30,12 @@ -- OCaml.BuckleScript.Types , OCamlType (..) , typeableToOCamlType- , TypeParameterRef0- , TypeParameterRef1- , TypeParameterRef2- , TypeParameterRef3- , TypeParameterRef4- , TypeParameterRef5+ , TypeParameterRef0(..)+ , TypeParameterRef1(..)+ , TypeParameterRef2(..)+ , TypeParameterRef3(..)+ , TypeParameterRef4(..)+ , TypeParameterRef5(..) -- servant spec , mkOCamlSpecServer
src/OCaml/Internal/Common.hs view
@@ -15,7 +15,7 @@ -- base import Data.Char (toLower,toUpper) import qualified Data.List as L-import Data.Monoid+import Data.Monoid ((<>)) -- aeson import qualified Data.Aeson.Types as Aeson (Options(..), defaultOptions)@@ -35,7 +35,8 @@ import qualified Data.Text.Lazy as LT -- wl-pprint-import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>))+import Text.PrettyPrint.Leijen.Text+ (Doc, (<+>), (<$$>), comma, line, linebreak, nest, text, displayT, renderPretty) -- | For URLs and POSIX systems.
test/Product.hs view
@@ -55,7 +55,9 @@ :> WrapThreeFilled :> WrapThreePartiallyFilled TypeParameterRef0 -- :> TypeSynonymKey TypeParameterRef0--- :> NewTypeKey TypeParameterRef0 +-- :> NewTypeKey TypeParameterRef0+ :<|> OCamlModule '["Box"] :> InnerBox TypeParameterRef0 :> OuterBox :> AuditAction :> AuditModel TypeParameterRef0 :> User :> UserAudit+ :<|> OCamlModule '["Key"] :> SqlKey :> UserId ) compareInterfaceFiles :: FilePath -> SpecWith ()@@ -422,7 +424,239 @@ instance (Typeable a, OCamlType a) => OCamlType (NewTypeKey a) +-- abc++data InnerBox a =+ InnerBox+ { ibA :: a+ , ibS :: String+ , ibX :: Int+ } deriving (Eq,Show,Generic,ToJSON,FromJSON)++instance (ToADTArbitrary a, Arbitrary a) => ToADTArbitrary (InnerBox a)+instance Arbitrary a => Arbitrary (InnerBox a) where+ arbitrary = InnerBox <$> arbitrary <*> arbitrary <*> arbitrary+instance (Typeable a, OCamlType a) => OCamlType (InnerBox a)++data OuterBox =+ OuterBox (InnerBox Person)+ deriving (Eq,Show,Generic,ToJSON,FromJSON)++instance ToADTArbitrary OuterBox+instance Arbitrary OuterBox where+ arbitrary = OuterBox <$> arbitrary+instance OCamlType OuterBox++data AuditAction = Create | Delete | Update+ deriving (Show, Read, Eq, Ord, Generic, Typeable, ToJSON, FromJSON)++instance ToADTArbitrary AuditAction+instance Arbitrary AuditAction where+ arbitrary = elements [Create, Delete, Update]+instance OCamlType AuditAction++data AuditModel a =+ AuditModel+ { auditModel :: a+ , originalId :: String+ , auditAction :: AuditAction+ , editedBy :: String+ , editedOn :: String+ } deriving (Read, Show, Eq, Generic, Typeable, ToJSON, FromJSON)++instance (ToADTArbitrary a, Arbitrary a) => ToADTArbitrary (AuditModel a)+instance (Arbitrary a) => Arbitrary (AuditModel a) where+ arbitrary = AuditModel <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+instance OCamlType (AuditModel TypeParameterRef0)++data User =+ User+ { userIdent :: String+ , userPassword :: Maybe (String)+ , userTimezone :: String+ } deriving (Eq, Generic, Ord, Read, Show, Typeable, ToJSON, FromJSON)++instance ToADTArbitrary User+instance Arbitrary User where+ arbitrary = User <$> arbitrary <*> arbitrary <*> arbitrary+instance OCamlType User++newtype UserAudit = UserAudit (AuditModel User)+ deriving (Read, Show, Eq, Generic, Typeable, ToJSON, FromJSON)++instance ToADTArbitrary UserAudit+instance Arbitrary UserAudit where+ arbitrary = UserAudit <$> arbitrary+instance OCamlType UserAudit+++newtype SqlKey = SqlKey Int deriving (Eq, Generic, Ord, Read, Show, Typeable, ToJSON, FromJSON, OCamlType)++instance ToADTArbitrary SqlKey+instance Arbitrary SqlKey where+ arbitrary = SqlKey <$> arbitrary++newtype UserId =+ UserId SqlKey+ deriving (Eq, Generic, Ord, Show, ToJSON, FromJSON, OCamlType)++instance ToADTArbitrary UserId+instance Arbitrary UserId where+ arbitrary = UserId <$> arbitrary++-- def+ {-+λ> toOCamlType (Proxy :: Proxy SqlKey)+OCamlDatatype+ (HaskellTypeMetaData "SqlKey" "Ghci1" "interactive")+ "SqlKey"+ (OCamlValueConstructor (NamedConstructor "SqlKey" (OCamlPrimitiveRef OInt)))++λ> toOCamlType (Proxy :: Proxy UserId)+OCamlDatatype+ (HaskellTypeMetaData "UserId" "Ghci2" "interactive")+ "UserId"+ (OCamlValueConstructor (NamedConstructor "UserId" (OCamlRef (HaskellTypeMetaData "SqlKey" "Ghci1" "interactive") "SqlKey")))++++:set -XDeriveGeneric+:set -XDeriveAnyClass+import Data.Proxy (Proxy(..))+import Data.Typeable (Typeable)+import OCaml.Export+import Data.Time (UTCTime)++data AuditAction = Create | Delete | Update+ deriving (Show, Read, Eq, Ord, Generic, Typeable, OCamlType)++data AuditModel a =+ AuditModel+ { auditModel :: a+ , originalId :: ByteString+ , auditAction :: AuditAction+ , editedBy :: Text+ , editedOn :: UTCTime+ } deriving (Read, Show, Eq, Generic, Typeable, OCamlType)++re-react-onping-frontend/src/PlowtechAuthenticationTypes.ml+data Wrapper a =+ Wrapper+ { wpa :: a+ } deriving (Eq,Show,Generic,OCamlType)++data SumWrapped+ = SW1+ | SW2 (Wrapper Int)+ | SW3 (Wrapper (Maybe String))+ | SW4 (Wrapper (Either Int String))+ deriving (Eq,Show,Generic,OCamlType)++toOCamlType (Proxy :: Proxy SumWrapped)++OCamlDatatype (HaskellTypeMetaData "SumWrapped" "Ghci1" "interactive") "SumWrapped" (OCamlValueConstructor (MultipleConstructors [MultipleConstructors [NamedConstructor "SW1" OCamlEmpty,NamedConstructor "SW2" (OCamlRefApp (Wrapper Int) (OCamlPrimitiveRef OInt))],MultipleConstructors [NamedConstructor "SW3" (OCamlRefApp (Wrapper (Maybe [Char])) (OCamlPrimitiveRef (OOption (OCamlPrimitive (OList (OCamlPrimitive OChar)))))),NamedConstructor "SW4" (OCamlRefApp (Wrapper (Either Int [Char])) (OCamlPrimitiveRef (OEither (OCamlPrimitive OInt) (OCamlPrimitive (OList (OCamlPrimitive OChar))))))]]))+++data InnerBox a =+ InnerBox+ { ibA :: a+ , ibS :: String+ , ibX :: Int+ } deriving (Eq,Show,Generic)++instance (Typeable a, OCamlType a) => OCamlType (InnerBox a)++data Person = Person+ { id :: Int+ , name :: Maybe String+ , created :: String+ } deriving (Show, Eq, Generic,OCamlType)+++data OuterBox =+ OuterBox (InnerBox Person)+ deriving (Eq,Show,Generic,OCamlType)++toOCamlType (Proxy :: Proxy OuterBox)++OCamlDatatype+ (HaskellTypeMetaData "OuterBox" "Ghci4" "interactive")+ "OuterBox"+ (OCamlValueConstructor+ (NamedConstructor+ "OuterBox"+ (OCamlRefApp+ (InnerBox Person)+ (OCamlRef (HaskellTypeMetaData "Person" "Ghci3" "interactive") "Person"))))++OCamlDatatype+ (HaskellTypeMetaData "NewType" "Ghci1" "interactive")+ "NewType"+ (OCamlValueConstructor+ (NamedConstructor+ "NewType"+ (OCamlPrimitiveRef OInt)))++newtype NewType+ = NewType Int+ deriving (Show,Eq,Generic,OCamlType)+++OCamlDatatype+ (HaskellTypeMetaData "SumWrapped" "Ghci1" "interactive")+ "SumWrapped"+ (OCamlValueConstructor+ (MultipleConstructors+ [MultipleConstructors+ [NamedConstructor "SW1" OCamlEmpty+ ,NamedConstructor+ "SW2"+ (OCamlRefApp+ (Wrapper Int)+ (OCamlPrimitiveRef OInt))]+ ,MultipleConstructors+ [NamedConstructor "SW3" (OCamlRefApp (Wrapper (Maybe [Char])) (OCamlPrimitiveRef (OOption (OCamlPrimitive (OList (OCamlPrimitive OChar))))))+ ,NamedConstructor "SW4" (OCamlRefApp (Wrapper (Either Int [Char])) (OCamlPrimitiveRef (OEither (OCamlPrimitive OInt) (OCamlPrimitive (OList (OCamlPrimitive OChar))))))]]))+++data UnnamedProduct = UnnamedProduct String Int+ deriving (Eq, Read, Show, Generic, OCamlType)++toOCamlType (Proxy :: Proxy UnnamedProduct)++OCamlDatatype+ (HaskellTypeMetaData "UnnamedProduct" "Ghci7" "interactive")+ "UnnamedProduct"+ (OCamlValueConstructor+ (NamedConstructor+ "UnnamedProduct"+ (Values+ (OCamlPrimitiveRef+ (OList (OCamlPrimitive OChar)))+ (OCamlPrimitiveRef OInt))))+++{-+data OCamlConstructor + = OCamlValueConstructor ValueConstructor -- ^ Sum, record (product with named fields) or product without named fields++data ValueConstructor+ = NamedConstructor Text OCamlValue -- ^ Product without named fields+ | RecordConstructor Text OCamlValue -- ^ Product with named fields+ | MultipleConstructors [ValueConstructor] -- ^ Sum type++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 NameConstructor or a RecordConstructor.+ | OCamlRefAppValues OCamlValue OCamlValue -- ^ User for multiple types in an OCamlRefApp. These are rendered in a different way from V+-}+ λ> toOCamlType (Proxy :: Proxy (Key User)) OCamlDatatype (HaskellTypeMetaData "Key" "Database.Persist.Class.PersistEntity" "persistent-2.6-HdpHylIi1gZ4QjAhgpXd6i") "Key" (OCamlValueConstructor (NamedConstructor "Key" OCamlEmpty)) λ
test/ProductApp.hs view
@@ -54,3 +54,5 @@ compareInterfaceFiles "UnnamedProduct" compareInterfaceFiles "ComplexProduct" compareInterfaceFiles "Wrapper"+ compareInterfaceFiles "Box"+ compareInterfaceFiles "Key"
test/Sum.hs view
@@ -156,6 +156,7 @@ | HasMultipleInts Int Int | HasMultipleTuples (Int,Int) (Int,Int) | HasMixed Int String Double+ | HasNameOrIdNumber NameOrIdNumber Int deriving (Show,Eq,Generic, OCamlType, ToJSON, FromJSON) instance Arbitrary SumVariant where@@ -167,6 +168,7 @@ , HasMultipleInts <$> arbitrary <*> arbitrary , HasMultipleTuples <$> arbitrary <*> arbitrary , HasMixed <$> arbitrary <*> arbitrary <*> arbitrary+ , HasNameOrIdNumber <$> arbitrary <*> arbitrary ] instance ToADTArbitrary SumVariant