reason-export 0.1.0.0 → 0.1.1.0
raw patch · 10 files changed
+105/−23 lines, 10 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- reason-export.cabal +5/−2
- src/Reason/Decoder.hs +25/−1
- src/Reason/Encoder.hs +20/−11
- test/ExportSpec.hs +29/−0
- test/MonstrosityEncoder.re +3/−3
- test/PositionEncoder.re +3/−3
- test/TimingEncoder.re +3/−3
- test/TwoArg.re +2/−0
- test/TwoArgDecoder.re +6/−0
- test/TwoArgEncoder.re +9/−0
reason-export.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 06d199b5f88dc43f668e59c63a8b8ace8d65cb76a08af2fbf3edeb41d0ba624e+-- hash: 7015fd5b78c9fc1af9039309e0fac1f7ab108a7c6f2ecbf73a88bd98fd64fb61 name: reason-export-version: 0.1.0.0+version: 0.1.1.0 synopsis: Generate Reason types from Haskell description: Please see the README on GitHub at <https://github.com/abarbu/reason-export#readme> category: Web@@ -47,6 +47,9 @@ test/TimingDecoder.re test/TimingEncoder.re test/TimingType.re+ test/TwoArg.re+ test/TwoArgDecoder.re+ test/TwoArgEncoder.re test/UnitDecoder.re test/UnitEncoder.re test/UnitType.re
src/Reason/Decoder.hs view
@@ -39,8 +39,23 @@ return $ "json |> Json.Decode.nullAs" <> parens (stext name) render (NamedConstructor name (ReasonPrimitiveRef RUnit)) = return $ "json |> Json.Decode.nullAs" <> parens (stext name)+ render (NamedConstructor name value@(Values _ _)) = do+ (_, tyargs) <- renderConstructorArgs' 0 value+ pure $ case tyargs of+ [] -> stext name+ [(r0,a0)] -> stext name <> parens (stext "json |> " <> r0)+ [(r0,a0), (r1,a1)] ->+ parens (parens (tupled [a0, a1]) <+> "=>" <+> stext name <> tupled [a0, a1])+ <> parens (stext "json |> Json.Decode.tuple2" <> tupled [r0, r1])+ [(r0,a0), (r1,a1), (r2,a2)] ->+ parens (parens (tupled [a0, a1]) <+> "=>" <+> stext name <> tupled [a0, a1, a2])+ <> parens (stext "json |> Json.Decode.tuple2" <> tupled [r0, r1, r2])+ [(r0,a0), (r1,a1), (r2,a2) , (r3,a3)] ->+ parens (parens (tupled [a0, a1]) <+> "=>" <+> stext name <> tupled [a0, a1, a2, a3])+ <> parens (stext "json |> Json.Decode.tuple2" <> tupled [r0, r1, r2, r3])+ _ -> error "Bare constructors with more than 4 arguments are not supported, use records" render (NamedConstructor name value) = do- (_, val) <- renderConstructorArgs 0 value+ (n, val) <- renderConstructorArgs 0 value return $ (stext name <+> parens val) render (RecordConstructor _ value) = do dv <- render value@@ -93,6 +108,15 @@ renderConstructorArgs i val = do rndrVal <- render val pure (i, "json |> Json.Decode.field" <+> tupled [dquotes ("arg" <> int i), rndrVal] <> comma)++renderConstructorArgs' :: Int -> ReasonValue -> RenderM (Int, [(Doc,Doc)])+renderConstructorArgs' i (Values l r) = do+ (iL, rndrL) <- renderConstructorArgs' i l+ (iR, rndrR) <- renderConstructorArgs' (iL + 1) r+ pure (iR, rndrL <> rndrR)+renderConstructorArgs' i val = do+ rndrVal <- render val+ pure (i, [(rndrVal, ("arg" <> int i))]) instance HasDecoder ReasonValue where render (ReasonRef name) = pure $ "decode" <> stext name
src/Reason/Encoder.hs view
@@ -39,12 +39,12 @@ return $ "Json.Encode.null" -- Single constructor, multiple values: create array with values render (NamedConstructor name value@(Values _ _)) = do- pure $ "TODO!!!"- -- let ps = constructorParameters 0 value- -- (dv, _) <- renderVariable ps value- -- let cs = stext name <+> foldl1 (<+>) ps <+> "->"- -- return . nest 4 $ "TODOXcase x of" <$$>- -- (nest 4 $ cs <$$> nest 4 ("Json.Encode.list identity" <$$> "[" <+> dv <$$> "]"))+ ps <- collectParameters' 0 value+ pure $ nest 4 $ "switch(x)" <+>+ (braces $ line <> "|" <+> stext name <> tupled (map snd ps) <+> "=>"+ <$$> indent 2 "Json.Encode.jsonArray([|"+ <$$> indent 4 (sep (punctuate comma (map (\(t,arg) -> t <> parens arg) ps)))+ <$$> indent 2 "|])") -- Single constructor, one value: skip constructor and r just the value render (NamedConstructor name value) = do dv <- render value@@ -71,20 +71,19 @@ renderSum c@(NamedConstructor name ReasonEmpty) = do dc <- render c let cs = stext name <+> "=>"- let tag = pair (dquotes "type") ("Json.Encode.string" <> parens (dquotes (stext name)))+ let tag = pair (dquotes "tag") ("Json.Encode.string" <> parens (dquotes (stext name))) return $ jsonEncodeObject cs tag [] renderSum (NamedConstructor name value) = do ps <- collectParameters 0 value let cs = stext name <> tupled (map fst ps) <+> "=>"- let tag = pair (dquotes "type") ("Json.Encode.string" <> parens (dquotes (stext name)))- -- let ct = comma <+> pair (dquotes "arg0") dc'+ let tag = pair (dquotes "tag") ("Json.Encode.string" <> parens (dquotes (stext name))) return $ jsonEncodeObject cs tag (map (\(i,p) -> indent 4 (pair (dquotes i) p)) ps) renderSum (RecordConstructor name value) = do dv <- render value let cs = stext name <+> "=>"- let tag = pair (dquotes "type") (dquotes $ stext name)+ let tag = pair (dquotes "tag") (dquotes $ stext name) let ct = comma <+> dv return $ jsonEncodeObject cs tag [ct] @@ -96,7 +95,7 @@ renderEnumeration :: ReasonConstructor -> RenderM Doc renderEnumeration (NamedConstructor name _) = return . nest 4 $ "|" <+> stext name <+> "=>" <+>- "Json.Encode.object_" <> parens (brackets (pair (dquotes "type") ("Json.Encode.string" <> (parens (dquotes (stext name))))))+ "Json.Encode.object_" <> parens (brackets (pair (dquotes "tag") ("Json.Encode.string" <> (parens (dquotes (stext name)))))) renderEnumeration (MultipleConstructors constrs) = do dc <- mapM renderEnumeration constrs return $ foldl1 (<$$>) dc@@ -183,3 +182,13 @@ collectParameters i v = do r <- render v pure $ [("arg" <> int i, r <> parens ("arg" <> int i))]++collectParameters' :: Int -> ReasonValue -> RenderM [(Doc,Doc)]+collectParameters' _ ReasonEmpty = pure []+collectParameters' i (Values l r) = do+ left <- collectParameters' i l+ right <- collectParameters' (length left + i) r+ pure $ left ++ right+collectParameters' i v = do+ r <- render v+ pure $ [(r, "arg" <> int i)]
test/ExportSpec.hs view
@@ -70,6 +70,9 @@ newtype Wrapper = Wrapper Int deriving (Generic, ReasonType) +data TwoArg = TwoArg String Double+ deriving (Generic, ReasonType)+ newtype FavoritePlaces = FavoritePlaces { positionsByUser :: Map String [Position] } deriving (Generic, ReasonType)@@ -153,6 +156,12 @@ defaultOptions (Proxy :: Proxy Wrapper) "test/WrapperType.re"+ it "toReasonTypeSource TwoArg" $+ shouldMatchTypeSource+ (unlines ["%s"])+ defaultOptions+ (Proxy :: Proxy TwoArg)+ "test/TwoArg.re" it "toReasonTypeSource FavoritePlaces" $ shouldMatchTypeSource (unlines@@ -319,6 +328,16 @@ defaultOptions (Proxy :: Proxy Wrapper) "test/WrapperDecoder.re"+ it "toReasonDecoderSource TwoArg" $+ shouldMatchDecoderSource+ (unlines+ [ "open TwoArgType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy TwoArg)+ "test/TwoArgDecoder.re" it "toReasonDecoderSource Shadowing" $ shouldMatchDecoderSource (unlines@@ -471,6 +490,16 @@ defaultOptions (Proxy :: Proxy Wrapper) "test/WrapperEncoder.re"+ it "toReasonEncoderSourceWithOptions TwoArg" $+ shouldMatchEncoderSource+ (unlines+ [ "open TwoArgType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy TwoArg)+ "test/TwoArgEncoder.re" describe "Convert to Reason encoder references." $ do it "toReasonEncoderRef Post" $ toReasonEncoderRef (Proxy :: Proxy Post) `shouldBe` "encodePost"
test/MonstrosityEncoder.re view
@@ -4,15 +4,15 @@ switch(x) { | NotSpecial => Json.Encode.object_- ([( "type", Json.Encode.string("NotSpecial") ),])+ ([( "tag", Json.Encode.string("NotSpecial") ),]) | OkayIGuess(arg0) => Json.Encode.object_- ([( "type", Json.Encode.string("OkayIGuess") ),+ ([( "tag", Json.Encode.string("OkayIGuess") ), ( "arg0", encodeMonstrosity(arg0) ),]) | Ridiculous(arg0,arg1,arg2) => Json.Encode.object_- ([( "type", Json.Encode.string("Ridiculous") ),+ ([( "tag", Json.Encode.string("Ridiculous") ), ( "arg0", Json.Encode.int(arg0) ), ( "arg1", Json.Encode.string(arg1) ), ( "arg2", (Json.Encode.list(encodeMonstrosity))(arg2) ),])}
test/PositionEncoder.re view
@@ -2,6 +2,6 @@ let rec encodePosition = (x : position) => switch(x) {- | Beginning => Json.Encode.object_([( "type", Json.Encode.string("Beginning") )])- | Middle => Json.Encode.object_([( "type", Json.Encode.string("Middle") )])- | End => Json.Encode.object_([( "type", Json.Encode.string("End") )])}+ | Beginning => Json.Encode.object_([( "tag", Json.Encode.string("Beginning") )])+ | Middle => Json.Encode.object_([( "tag", Json.Encode.string("Middle") )])+ | End => Json.Encode.object_([( "tag", Json.Encode.string("End") )])}
test/TimingEncoder.re view
@@ -4,12 +4,12 @@ switch(x) { | Start => Json.Encode.object_- ([( "type", Json.Encode.string("Start") ),])+ ([( "tag", Json.Encode.string("Start") ),]) | Continue(arg0) => Json.Encode.object_- ([( "type", Json.Encode.string("Continue") ),+ ([( "tag", Json.Encode.string("Continue") ), ( "arg0", Json.Encode.float(arg0) ),]) | Stop => Json.Encode.object_- ([( "type", Json.Encode.string("Stop") ),])}+ ([( "tag", Json.Encode.string("Stop") ),])}
+ test/TwoArg.re view
@@ -0,0 +1,2 @@+type twoArg =+ | TwoArg(string, float)
+ test/TwoArgDecoder.re view
@@ -0,0 +1,6 @@+open TwoArgType;++let rec decodeTwoArg = json =>+ (((arg0,arg1)) => TwoArg(arg0+ ,arg1))(json |> Json.Decode.tuple2(Json.Decode.string+ ,Json.Decode.float))
+ test/TwoArgEncoder.re view
@@ -0,0 +1,9 @@+open TwoArgType;++let rec encodeTwoArg = (x : twoArg) =>+ switch(x) {+ | TwoArg(arg0,arg1) =>+ Json.Encode.jsonArray([|+ Json.Encode.string(arg0),+ Json.Encode.float(arg1)+ |])}