diff --git a/ocaml-export.cabal b/ocaml-export.cabal --- a/ocaml-export.cabal +++ b/ocaml-export.cabal @@ -1,11 +1,11 @@ --- This file has been generated from package.yaml by hpack version 0.20.0. +-- This file has been generated from package.yaml by hpack version 0.28.2. -- -- see: https://github.com/sol/hpack -- --- hash: 8ba9cf12795b26fa199a0b74560d1d13c2ee2f1c686baed377ef3127ff1d9789 +-- hash: 8c174c8aea9f9e12c093c4b32df7c7d3734d09caa318020132493d136120bb26 name: ocaml-export -version: 0.7.0.0 +version: 0.9.0.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,11 +31,11 @@ library hs-source-dirs: src - ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wredundant-constraints -fprint-potential-instances + ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -Wredundant-constraints -fprint-potential-instances build-depends: QuickCheck , aeson - , base >=4.7 && <5 + , base >=4.10 && <5 , bytestring , containers , directory @@ -48,11 +48,11 @@ , quickcheck-arbitrary-adt , servant , servant-server + , singletons , split - , template-haskell <2.12.0.0 + , template-haskell , text , time - , typelits-witnesses , wl-pprint-text exposed-modules: OCaml.Export @@ -74,11 +74,11 @@ main-is: Spec.hs hs-source-dirs: test - ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints + ghc-options: -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-depends: QuickCheck , aeson - , base >=4.7 && <5 + , base >=4.10 && <5 , bytestring , containers , directory @@ -90,10 +90,10 @@ , quickcheck-arbitrary-adt , servant , servant-server - , template-haskell <2.12.0.0 + , singletons + , template-haskell , text , time - , typelits-witnesses , wai , wai-extra , warp diff --git a/src/OCaml/BuckleScript/Decode.hs b/src/OCaml/BuckleScript/Decode.hs --- a/src/OCaml/BuckleScript/Decode.hs +++ b/src/OCaml/BuckleScript/Decode.hs @@ -79,13 +79,13 @@ let typeParameterInterfaces = linesBetween $ catMaybes (renderSumRecordInterface typeName . OCamlValueConstructor <$> constructors) (typeParameterEncoders, typeParameters) = renderTypeParameterVals constructor pure $ typeParameterInterfaces - <$$> "val" <+> fnName <+> ":" <+> typeParameterEncoders <> "Js_json.t ->" <+> "(" <> typeParameters <> (stext . textLowercaseFirst $ typeName) <> ", string)" <+> "Js_result.t" + <$$> "val" <+> fnName <+> ":" <+> typeParameterEncoders <> "Js_json.t ->" <+> "(" <> typeParameters <> (stext . textLowercaseFirst $ typeName) <> ", string)" <+> "Belt.Result.t" renderInterface datatype@(OCamlDatatype _ typeName constructors) = do fnName <- renderRef datatype let (typeParameterEncoders, typeParameters) = renderTypeParameterVals constructors - pure $ "val" <+> fnName <+> ":" <+> typeParameterEncoders <> "Js_json.t ->" <+> "(" <> typeParameters <> (stext . textLowercaseFirst $ typeName) <> ", string)" <+> "Js_result.t" + pure $ "val" <+> fnName <+> ":" <+> typeParameterEncoders <> "Js_json.t ->" <+> "(" <> typeParameters <> (stext . textLowercaseFirst $ typeName) <> ", string)" <+> "Belt.Result.t" renderInterface _ = pure "" @@ -104,12 +104,12 @@ else do let (typeParameterSignatures,typeParameters) = renderTypeParameters constructor pure $ typeParameterDeclarations <$$> - ("let" <+> fnName <+> typeParameterSignatures <+> "(json : Js_json.t)" <+> typeParameters <> ":(" <> stext (textLowercaseFirst typeName) <> ", string) Js_result.t =") <$$> + ("let" <+> fnName <+> typeParameterSignatures <+> "(json : Js_json.t)" <+> typeParameters <> ":(" <> stext (textLowercaseFirst typeName) <> ", string) Belt.Result.t =") <$$> (indent 2 ("match Aeson.Decode.(field \"tag\" string json) with" <$$> foldl1 (<$$>) fnBody <$$> fnFooter)) where fnFooter = - "| err -> Js_result.Error (\"Unknown tag value found '\" ^ err ^ \"'.\")" - <$$> "| exception Aeson.Decode.DecodeError message -> Js_result.Error message" + "| err -> Belt.Result.Error (\"Unknown tag value found '\" ^ err ^ \"'.\")" + <$$> "| exception Aeson.Decode.DecodeError message -> Belt.Result.Error message" render datatype@(OCamlDatatype _ name constructor@(OCamlEnumeratorConstructor constructors)) = do @@ -123,14 +123,14 @@ <$$> foldl1 (<$$>) fnBody <$$> fnFooter fnName) else do let (typeParameterSignatures,typeParameters) = renderTypeParameters constructor - returnType = "(" <> typeParameters <> (stext . textLowercaseFirst $ name) <> ", string) Js_result.t =" + returnType = "(" <> typeParameters <> (stext . textLowercaseFirst $ name) <> ", string) Belt.Result.t =" pure $ "let" <+> fnName <+> typeParameterSignatures <+>"(json : Js_json.t) :" <> returnType <$$> indent 2 ("match Js_json.decodeString json with" <$$> foldl1 (<$$>) fnBody <$$> fnFooter fnName) where fnFooter fnName - = "| Some err -> Js_result.Error (\"" <> fnName <> ": unknown enumeration '\" ^ err ^ \"'.\")" - <$$> "| None -> Js_result.Error \"" <> fnName <> ": expected a top-level JSON string.\"" + = "| 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 @@ -143,7 +143,7 @@ pure $ "let" <+> fnName <+> renderedTypeParameters <+> "json" <+> "=" <$$> fnBody else do let (typeParameterSignatures,typeParameters) = renderTypeParameters constructor - returnType = "(" <> typeParameters <> (stext . textLowercaseFirst $ name) <> ", string) Js_result.t =" + returnType = "(" <> typeParameters <> (stext . textLowercaseFirst $ name) <> ", string) Belt.Result.t =" pure $ "let" <+> fnName <+> typeParameterSignatures <+> "(json : Js_json.t) :" <> returnType <$$> fnBody render (OCamlPrimitive primitive) = renderRef primitive @@ -195,11 +195,11 @@ indent 2 $ "match Js.Json.decodeArray json with" <$$> "| Some v ->" <$$> (indent 2 v) - <$$> "| None -> Js_result.Error (\"" <> (stext name) <+> "expected an array.\")" + <$$> "| None -> Belt.Result.Error (\"" <> (stext name) <+> "expected an array.\")" else indent 2 $ "match Aeson.Decode." <> decoder <+> "json" <+> "with" - <$$> "| v -> Js_result.Ok" <+> parens (stext name <+> "v") - <$$> "| exception Aeson.Decode.DecodeError msg -> Js_result.Error (\"decode" <> (stext . textUppercaseFirst $ name) <> ": \" ^ msg)" + <$$> "| v -> Belt.Result.Ok" <+> parens (stext name <+> "v") + <$$> "| exception Aeson.Decode.DecodeError msg -> Belt.Result.Error (\"decode" <> (stext . textUppercaseFirst $ name) <> ": \" ^ msg)" render (OCamlValueConstructor (RecordConstructor name value)) = do decoders <- render value @@ -207,8 +207,8 @@ $ " match Aeson.Decode." <$$> (indent 4 ("{" <+> decoders <$$> "}")) <$$> " with" - <$$> " | v -> Js_result.Ok v" - <$$> " | exception Aeson.Decode.DecodeError message -> Js_result.Error (\"decode" <> (stext . textUppercaseFirst $ name) <> ": \" ^ message)" + <$$> " | v -> Belt.Result.Ok v" + <$$> " | exception Aeson.Decode.DecodeError message -> Belt.Result.Error (\"decode" <> (stext . textUppercaseFirst $ name) <> ": \" ^ message)" render (OCamlValueConstructor (MultipleConstructors constructors)) = do decoders <- mapM (renderSum . OCamlValueConstructor) constructors @@ -216,8 +216,8 @@ <$$> indent 2 (foldl (<$$>) "" decoders) <$$> indent 2 fnFooter where - fnFooter = "| err -> Js_result.Error (\"Unknown tag value found '\" ^ err ^ \"'.\")" - <$$> "| exception Aeson.Decode.DecodeError message -> Js_result.Error message" + fnFooter = "| err -> Belt.Result.Error (\"Unknown tag value found '\" ^ err ^ \"'.\")" + <$$> "| exception Aeson.Decode.DecodeError message -> Belt.Result.Error message" render _ = pure "" @@ -262,7 +262,7 @@ render OCamlEmpty = pure "" instance HasDecoder EnumeratorConstructor where - render (EnumeratorConstructor name) = pure $ "| Some \"" <> stext name <> "\" -> Js_result.Ok" <+> stext name + render (EnumeratorConstructor name) = pure $ "| Some \"" <> stext name <> "\" -> Belt.Result.Ok" <+> stext name instance HasDecoderRef OCamlValue where renderRef (OCamlRefAppValues x y) = do @@ -280,6 +280,7 @@ renderRef ODate = pure "date" renderRef OFloat = pure "Aeson.Decode.float" -- this is to prevent overshadowing warning renderRef OInt = pure "int" + renderRef OInt32 = pure "int32" renderRef OString = pure "string" renderRef OUnit = pure $ parens "()" renderRef (OList (OCamlPrimitive OChar)) = pure "string" @@ -292,10 +293,10 @@ dv0 <- renderRefWithUnwrapResult v0 pure . parens $ "optional" <+> dv0 - renderRef (OEither v0 v1) = do - dv0 <- renderRefWithUnwrapResult v0 - dv1 <- renderRefWithUnwrapResult v1 - pure $ parens $ "either" <+> dv0 <+> dv1 + renderRef (OEither l r) = do + dl <- renderRefWithUnwrapResult l + dr <- renderRefWithUnwrapResult r + pure $ parens $ "either" <+> dl <+> dr renderRef (OTuple2 v0 v1) = do dv0 <- renderRefWithUnwrapResult v0 @@ -342,7 +343,7 @@ 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 + pure $ Just $ "let decode" <> stext sumRecordName <+> "(json : Js_json.t)" <+> ":(" <> (stext $ textLowercaseFirst sumRecordName) <> ", string)" <+> "Belt.Result.t =" <$$> fnBody renderSumRecord _ _ = return Nothing @@ -402,7 +403,7 @@ -- | Render a sum type constructor in context of a data type with multiple -- constructors. renderSum :: OCamlConstructor -> Reader TypeMetaData Doc -renderSum (OCamlValueConstructor (NamedConstructor name OCamlEmpty)) = renderSumCondition name ("Js_result.Ok" <+> stext name) +renderSum (OCamlValueConstructor (NamedConstructor name OCamlEmpty)) = renderSumCondition name ("Belt.Result.Ok" <+> stext name) renderSum (OCamlValueConstructor (NamedConstructor name v@(Values _ _))) = do val <- rArgs name v renderSumCondition name val @@ -415,8 +416,8 @@ ("match Aeson.Decode." <> parens ("field \"contents\"" <+> (unwrapIfTypeParameter value val) <+> "json") <+> "with" <$$> indent 1 - ( "| v -> Js_result.Ok (" <> (stext name) <+> "v)" - <$$> "| exception Aeson.Decode.DecodeError message -> Js_result.Error (\"" <> (stext jsonConstructorName) <> ": \" ^ message)" + ( "| v -> Belt.Result.Ok (" <> (stext name) <+> "v)" + <$$> "| exception Aeson.Decode.DecodeError message -> Belt.Result.Error (\"" <> (stext jsonConstructorName) <> ": \" ^ message)" ) <> line ) @@ -441,8 +442,8 @@ pure $ "|" <+> (dquotes . stext $ name) <+> "->" <$$> indent 3 ("(match" <+> "decode" <> (stext $ typeName <> textUppercaseFirst name) <+> "json" <+> "with" - <$$> indent 1 ("| Js_result.Ok v -> Js_result.Ok" <+> (parens ((stext $ textUppercaseFirst name) <+> "v")) - <$$> "| Js_result.Error message -> Js_result.Error" <+> (parens $ (dquotes $ "decode" <> stext typeName <> ": ") <+> "^ message")) + <$$> indent 1 ("| Belt.Result.Ok v -> Belt.Result.Ok" <+> (parens ((stext $ textUppercaseFirst name) <+> "v")) + <$$> "| Belt.Result.Error message -> Belt.Result.Error" <+> (parens $ (dquotes $ "decode" <> stext typeName <> ": ") <+> "^ message")) <$$> ")") @@ -460,14 +461,14 @@ parens $ "match Aeson.Decode.(field \"contents\" Js.Json.decodeArray json) with" <$$> (indent 1 "| Some v ->" <$$> (indent 3 v) - <$$> (indent 1 "| None -> Js_result.Error (\"" <> (stext name) <+> "expected an array.\")" )) <> line + <$$> (indent 1 "| None -> Belt.Result.Error (\"" <> (stext name) <+> "expected an array.\")" )) <> line mk :: Text -> Int -> [Maybe OCamlValue] -> Reader TypeMetaData Doc mk name i [x] = case x of Nothing -> do let ts = foldl (<>) "" $ L.intersperse ", " ((stext . T.append "v" . T.pack . show) <$> [0..i-1]) - pure $ indent 1 $ "Js_result.Ok" <+> parens (stext name <+> parens ts) + pure $ indent 1 $ "Belt.Result.Ok" <+> parens (stext name <+> parens ts) Just _ -> pure "" mk name i (x:xs) = case x of @@ -480,7 +481,7 @@ <$$> indent 1 ("| v" <> iDoc <+> "->" <$$> (indent 2 renderedInternal) - <$$> "| exception Aeson.Decode.DecodeError message -> Js_result.Error (\"" <> (stext name) <> ": \" ^ message)" + <$$> "| exception Aeson.Decode.DecodeError message -> Belt.Result.Error (\"" <> (stext name) <> ": \" ^ message)" ) <$$> ")" @@ -489,7 +490,7 @@ renderTypeParameterValsAux :: [OCamlValue] -> (Doc,Doc) renderTypeParameterValsAux ocamlValues = let typeParameterNames = (<>) "'" <$> (L.sort $ getTypeParameterRefNames ocamlValues) - typeDecs = (foldl (<>) "" $ L.intersperse " -> " $ (\t -> "(Js_json.t -> (" <> (stext t) <> ", string) Js_result.t)") <$> typeParameterNames) <> " -> " + typeDecs = (foldl (<>) "" $ L.intersperse " -> " $ (\t -> "(Js_json.t -> (" <> (stext t) <> ", string) Belt.Result.t)") <$> typeParameterNames) <> " -> " in if length typeParameterNames > 0 then @@ -508,7 +509,7 @@ renderTypeParametersAux ocamlValues = do let typeParameterNames = getTypeParameterRefNames ocamlValues typeDecs = (\t -> "(type " <> (stext t) <> ")") <$> typeParameterNames :: [Doc] - encoderDecs = (\t -> "(decode" <> (stext $ textUppercaseFirst t) <+> ":" <+> "Js_json.t -> (" <> (stext t) <> ", string) Js_result.t)" ) <$> typeParameterNames :: [Doc] + encoderDecs = (\t -> "(decode" <> (stext $ textUppercaseFirst t) <+> ":" <+> "Js_json.t -> (" <> (stext t) <> ", string) Belt.Result.t)" ) <$> typeParameterNames :: [Doc] typeParams = foldl (<>) "" $ if length typeParameterNames > 1 then ["("] <> (L.intersperse ", " $ stext <$> typeParameterNames) <> [") "] else ((\x -> stext $ x <> " ") <$> typeParameterNames) :: [Doc] (foldl (<+>) "" (typeDecs ++ encoderDecs), typeParams ) @@ -525,7 +526,7 @@ -- | Render an OCaml val interface for a record constructor in a sum of records renderSumRecordInterface :: Text -> OCamlConstructor -> Maybe Doc renderSumRecordInterface typeName (OCamlValueConstructor (RecordConstructor name _value)) = - Just $ "val decode" <> (stext $ typeName <> name) <+> ":" <+> "Js_json.t" <+> "->" <+> parens (stext (textLowercaseFirst $ typeName <> name) <> comma <+> "string") <+> "Js_result.t" + Just $ "val decode" <> (stext $ typeName <> name) <+> ":" <+> "Js_json.t" <+> "->" <+> parens (stext (textLowercaseFirst $ typeName <> name) <> comma <+> "string") <+> "Belt.Result.t" renderSumRecordInterface _ _ = Nothing -- | If this type comes from a different OCaml module, then add the appropriate module prefix and add unwrapResult to make the diff --git a/src/OCaml/BuckleScript/Encode.hs b/src/OCaml/BuckleScript/Encode.hs --- a/src/OCaml/BuckleScript/Encode.hs +++ b/src/OCaml/BuckleScript/Encode.hs @@ -301,6 +301,7 @@ renderRef ODate = pure "Aeson.Encode.date" renderRef OFloat = pure "Aeson.Encode.float" renderRef OInt = pure "Aeson.Encode.int" + renderRef OInt32 = pure "Aeson.Encode.int32" renderRef OString = pure "Aeson.Encode.string" renderRef OUnit = pure "Aeson.Encode.null" @@ -314,10 +315,10 @@ 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 (OEither l r) = do + dl <- renderRef l + dr <- renderRef r + pure . parens $ "Aeson.Encode.either" <+> dl <+> dr renderRef (OTuple2 t0 t1) = do dt0 <- renderRef t0 @@ -406,12 +407,7 @@ let jsonConstructorName = T.pack . Aeson.constructorTagModifier ao . T.unpack $ name constructorMatchCase = "|" <+> stext name <+> "->" encodeTag = pair (dquotes "tag") ("Aeson.Encode.string" <+> dquotes (stext jsonConstructorName)) -#if MIN_VERSION_aeson(1,1,0) - encodeContents = ";" <+> pair (dquotes "contents") ("Aeson.Encode.array [| |]") - pure $ jsonEncodeObject constructorMatchCase encodeTag (Just encodeContents) -#else pure $ jsonEncodeObject constructorMatchCase encodeTag Nothing -#endif renderSum (OCamlValueConstructor (NamedConstructor name value)) = do let constructorParams = constructorParameters 0 value diff --git a/src/OCaml/BuckleScript/Internal/Module.hs b/src/OCaml/BuckleScript/Internal/Module.hs --- a/src/OCaml/BuckleScript/Internal/Module.hs +++ b/src/OCaml/BuckleScript/Internal/Module.hs @@ -18,6 +18,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} module OCaml.BuckleScript.Internal.Module ( @@ -220,21 +221,39 @@ instance (HasEmbeddedFile' api) => HasEmbeddedFile api where mkFiles includeInterface includeSpec Proxy = ListE <$> mkFiles' includeInterface includeSpec (Proxy :: Proxy api) --- | Help function for HasEmbeddedFile. class HasEmbeddedFile' api where mkFiles' :: Bool -> Bool -> Proxy api -> Q [Exp] -instance (HasEmbeddedFile' a, HasEmbeddedFile' b) => HasEmbeddedFile' (a :<|> b) where - mkFiles' includeInterface includeSpec Proxy = (<>) <$> mkFiles' includeInterface includeSpec (Proxy :: Proxy a) <*> mkFiles' includeInterface includeSpec (Proxy :: Proxy b) +instance (HasEmbeddedFileFlag a ~ flag, HasEmbeddedFile'' flag (a :: *)) => HasEmbeddedFile' a where + mkFiles' = mkFiles'' (Proxy :: Proxy flag) -instance (HasEmbeddedFile' a, HasEmbeddedFile' b) => HasEmbeddedFile' (a :> b) where - mkFiles' includeInterface includeSpec Proxy = (<>) <$> mkFiles' includeInterface includeSpec (Proxy :: Proxy a) <*> mkFiles' includeInterface includeSpec (Proxy :: Proxy b) +type family (HasEmbeddedFileFlag a) :: Nat where + HasEmbeddedFileFlag (a :<|> b) = 5 + HasEmbeddedFileFlag (a :> b) = 4 + HasEmbeddedFileFlag (HaskellTypeName a (OCamlTypeInFile b c)) = 3 + HasEmbeddedFileFlag (OCamlTypeInFile b c) = 2 + HasEmbeddedFileFlag a = 1 -instance (HasEmbeddedFile' (OCamlTypeInFile a b)) => HasEmbeddedFile' (HaskellTypeName typSymbol (OCamlTypeInFile a b)) where - mkFiles' includeInterface includeSpec Proxy = mkFiles' includeInterface includeSpec (Proxy :: Proxy (OCamlTypeInFile a b)) +-- | Helper function to work avoid overlapped instances. +class HasEmbeddedFile'' (flag :: Nat) api where + mkFiles'' :: Proxy flag -> Bool -> Bool -> Proxy api -> Q [Exp] -instance (Typeable a, KnownSymbol b) => HasEmbeddedFile' (OCamlTypeInFile a b) where - mkFiles' includeInterface includeSpec Proxy = do +instance (HasEmbeddedFile' a, HasEmbeddedFile' b) => HasEmbeddedFile'' 5 (a :<|> b) where + mkFiles'' _ includeInterface includeSpec Proxy = + (<>) <$> mkFiles' includeInterface includeSpec (Proxy :: Proxy a) + <*> mkFiles' includeInterface includeSpec (Proxy :: Proxy b) + +instance (HasEmbeddedFile' a, HasEmbeddedFile' b) => HasEmbeddedFile'' 4 (a :> b) where + mkFiles'' _ includeInterface includeSpec Proxy = + (<>) <$> mkFiles' includeInterface includeSpec (Proxy :: Proxy a) + <*> mkFiles' includeInterface includeSpec (Proxy :: Proxy b) + +instance (HasEmbeddedFile' (OCamlTypeInFile a b)) => HasEmbeddedFile'' 3 (HaskellTypeName typSymbol (OCamlTypeInFile a b)) where + mkFiles'' _ includeInterface includeSpec Proxy = + mkFiles' includeInterface includeSpec (Proxy :: Proxy (OCamlTypeInFile a b)) + +instance (Typeable a, KnownSymbol b) => HasEmbeddedFile'' 2 (OCamlTypeInFile a b) where + mkFiles'' _ includeInterface includeSpec Proxy = do let typeFilePath = symbolVal (Proxy :: Proxy b) let typeName = tyConName . typeRepTyCon $ typeRep (Proxy :: Proxy a) ml <- embedFile (typeFilePath <.> "ml") @@ -248,6 +267,6 @@ else pure $ ConE $ mkName "Nothing" pure [TupE [LitE $ StringL typeName, AppE (AppE (AppE (ConE $ mkName "EmbeddedOCamlFiles") ml) mli) spec]] - -instance {-# OVERLAPPABLE #-} HasEmbeddedFile' a where - mkFiles' _ _ Proxy = pure [] + +instance HasEmbeddedFile'' 1 a where + mkFiles'' _ _ _ Proxy = pure [] diff --git a/src/OCaml/BuckleScript/Internal/Package.hs b/src/OCaml/BuckleScript/Internal/Package.hs --- a/src/OCaml/BuckleScript/Internal/Package.hs +++ b/src/OCaml/BuckleScript/Internal/Package.hs @@ -47,8 +47,10 @@ import Data.Monoid ((<>)) import Data.Proxy (Proxy (..)) import Data.Typeable (typeRep, Typeable, typeRepTyCon, tyConName, tyConModule, tyConPackage) -import GHC.TypeLits +import Data.Singletons.Prelude (SingI(..), fromSing) +import Data.Singletons.TypeLits + -- containers import qualified Data.Map.Strict as Map @@ -71,11 +73,6 @@ import qualified Data.Text as T import qualified Data.Text.IO as T --- typelits-witnesses -import GHC.TypeLits.List - - - -- ============================================== -- Types -- ============================================== @@ -145,9 +142,6 @@ mkPackage' Proxy packageOptions = mkModule (Proxy :: Proxy a) packageOptions - - - -- | Depending on 'PackageOptions' settings, 'mkModule' can -- - make a declaration file containing encoders and decoders -- - make an OCaml interface file @@ -155,8 +149,11 @@ class HasOCamlModule a where mkModule :: Proxy a -> PackageOptions -> Map.Map HaskellTypeMetaData OCamlTypeMetaData -> IO () -instance (KnownSymbols modules, HasOCamlModule' api) => HasOCamlModule ((OCamlModule modules) :> api) where - mkModule Proxy packageOptions deps = mkModule' (Proxy :: Proxy api) (symbolsVal (Proxy :: Proxy modules)) packageOptions deps +instance (SingI modules, HasOCamlModule' api) => HasOCamlModule ((OCamlModule modules) :> api) where + mkModule Proxy packageOptions deps = + let s = sing :: Sing modules + r = fromSing s :: [Text] + in mkModule' (Proxy :: Proxy api) (T.unpack <$> r) packageOptions deps class HasOCamlModule' a where mkModule' :: Proxy a -> [String] -> PackageOptions -> Map.Map HaskellTypeMetaData OCamlTypeMetaData -> IO () @@ -216,8 +213,8 @@ mkOCamlTypeMetaData Proxy = mkOCamlTypeMetaData (Proxy :: Proxy modul) <> mkOCamlTypeMetaData (Proxy :: Proxy rst) -- | single module -instance (KnownSymbols modules, HasOCamlTypeMetaData' api) => HasOCamlTypeMetaData ((OCamlModule modules) :> api) where - mkOCamlTypeMetaData Proxy = Map.fromList $ mkOCamlTypeMetaData' (T.pack <$> symbolsVal (Proxy :: Proxy modules)) [] (Proxy :: Proxy api) +instance (SingI modules, HasOCamlTypeMetaData' api) => HasOCamlTypeMetaData ((OCamlModule modules) :> api) where + mkOCamlTypeMetaData Proxy = Map.fromList $ mkOCamlTypeMetaData' (fromSing (sing :: Sing modules)) [] (Proxy :: Proxy api) -- | empty list instance HasOCamlTypeMetaData '[] where diff --git a/src/OCaml/BuckleScript/Record.hs b/src/OCaml/BuckleScript/Record.hs --- a/src/OCaml/BuckleScript/Record.hs +++ b/src/OCaml/BuckleScript/Record.hs @@ -213,6 +213,7 @@ renderRef ODate = pure "Js_date.t" renderRef OFloat = pure "float" renderRef OInt = pure "int" + renderRef OInt32 = pure "int32" renderRef OString = pure "string" renderRef OUnit = pure "unit" @@ -226,10 +227,10 @@ 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 (OEither l r) = do + dl <- renderRef l + dr <- renderRef r + pure $ (parens $ dl <> comma <+> dr) <+> "Aeson.Compatibility.Either.t" renderRef (OTuple2 a b) = do da <- renderRef a diff --git a/src/OCaml/BuckleScript/Types.hs b/src/OCaml/BuckleScript/Types.hs --- a/src/OCaml/BuckleScript/Types.hs +++ b/src/OCaml/BuckleScript/Types.hs @@ -118,6 +118,7 @@ | ODate -- ^ Js_date.t | OFloat -- ^ float | OInt -- ^ int + | OInt32 -- ^ int32 | OString -- ^ string | OUnit -- ^ () | OList OCamlDatatype -- ^ 'a list, 'a Js_array.t @@ -323,7 +324,7 @@ [ ( 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 Int32), OInt32) , ( typeRepTyCon $ typeRep (Proxy :: Proxy Int64), OInt) , ( typeRepTyCon $ typeRep (Proxy :: Proxy Integer), OInt) , ( typeRepTyCon $ typeRep (Proxy :: Proxy Word), OInt) @@ -447,7 +448,7 @@ toOCamlType _ = OCamlPrimitive OInt instance OCamlType Int32 where - toOCamlType _ = OCamlPrimitive OInt + toOCamlType _ = OCamlPrimitive OInt32 instance OCamlType Int64 where toOCamlType _ = OCamlPrimitive OInt