ocaml-export 0.7.0.0 → 0.9.0.0
raw patch · 7 files changed
+99/−84 lines, 7 filesdep +singletonsdep −typelits-witnessesdep ~basedep ~template-haskell
Dependencies added: singletons
Dependencies removed: typelits-witnesses
Dependency ranges changed: base, template-haskell
Files
- ocaml-export.cabal +11/−11
- src/OCaml/BuckleScript/Decode.hs +34/−33
- src/OCaml/BuckleScript/Encode.hs +5/−9
- src/OCaml/BuckleScript/Internal/Module.hs +31/−12
- src/OCaml/BuckleScript/Internal/Package.hs +10/−13
- src/OCaml/BuckleScript/Record.hs +5/−4
- src/OCaml/BuckleScript/Types.hs +3/−2
ocaml-export.cabal view
@@ -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
src/OCaml/BuckleScript/Decode.hs view
@@ -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
src/OCaml/BuckleScript/Encode.hs view
@@ -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
src/OCaml/BuckleScript/Internal/Module.hs view
@@ -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 []
src/OCaml/BuckleScript/Internal/Package.hs view
@@ -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
src/OCaml/BuckleScript/Record.hs view
@@ -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
src/OCaml/BuckleScript/Types.hs view
@@ -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