packages feed

reason-export 0.1.1.0 → 0.1.2.0

raw patch · 12 files changed

+132/−84 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

reason-export.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 7015fd5b78c9fc1af9039309e0fac1f7ab108a7c6f2ecbf73a88bd98fd64fb61+-- hash: 301ed4c6277166825ece93357a0ba2513d50ae09b76e02dbaaa0b76195df45b2  name:           reason-export-version:        0.1.1.0+version:        0.1.2.0 synopsis:       Generate Reason types from Haskell description:    Please see the README on GitHub at <https://github.com/abarbu/reason-export#readme> category:       Web
src/Reason/Decoder.hs view
@@ -43,57 +43,56 @@     (_, tyargs) <- renderConstructorArgs' 0 value     pure $ case tyargs of       [] -> stext name-      [(r0,a0)] -> stext name <> parens (stext "json |> " <> r0)+      [(r0,_)] -> 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])+        <> parens (stext "json |> Json.Decode.tuple3" <> 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])+        <> parens (stext "json |> Json.Decode.tuple4" <> tupled [r0, r1, r2, r3])       _ -> error "Bare constructors with more than 4 arguments are not supported, use records"   render (NamedConstructor name value) = do-    (n, val) <- renderConstructorArgs 0 value+    (_, val) <- renderConstructorArgs 0 value     return $ (stext name <+> parens val)   render (RecordConstructor _ value) = do     dv <- render value     return $ braces (line <> indent 4 dv)-  render (MultipleConstructors constrs) = do-      cstrs <- mapM renderSum constrs-      pure $ line+  render mc@(MultipleConstructors constrs) = do+    cstrs <- mapM renderSum constrs+    pure $ line               <> indent 4                ("json |>" <+> parens-                 (constructorName <$$> indent 4+                 ((if isEnumeration mc then+                     "Json.Decode.string" else+                     "Json.Decode.field(\"tag\", Json.Decode.string)")+                   <$$> indent 4                   ("|> Json.Decode.andThen" <$$>                    parens ("(x) => switch(x)" <$$> braces (                               line <> indent 4 (foldl1 (<$$>) cstrs                                                 <$$> "|" <+> "_ =>" <+> "failwith(\"unknown constructor\")"))))))-    where-      constructorName :: Doc-      constructorName = "Json.Decode.field(\"type\", Json.Decode.string)"    -- | "<name>" -> decode <name> renderSumCondition :: T.Text -> Doc -> RenderM Doc renderSumCondition name contents =-  pure $ "|" <+> dquotes (stext name) <+> "=> json => " <+> stext name <> (if isEmpty contents then-                                                                              empty else-                                                                              parens contents)+  pure $ "|" <+> dquotes (stext name) <+> "=> json =>" <+> contents  -- | Render a sum type constructor in context of a data type with multiple -- constructors. renderSum :: ReasonConstructor -> RenderM Doc-renderSum (NamedConstructor name ReasonEmpty) = renderSumCondition name mempty-renderSum (NamedConstructor name v@(Values _ _)) = do-  (_, val) <- renderConstructorArgs 0 v-  renderSumCondition name val+renderSum (NamedConstructor name ReasonEmpty) = do+  renderSumCondition name (stext name)+renderSum n@(NamedConstructor name (Values _ _)) = do+  r <- render n+  renderSumCondition name r renderSum (NamedConstructor name value) = do-  val <- render value-  renderSumCondition name $ "json |> Json.Decode.field" <> tupled [dquotes "arg0", val]+  r <- render value+  renderSumCondition name (stext name <> parens ("json |> Json.Decode.field(\"contents\", " <> r <> ")")) renderSum (RecordConstructor name value) = do   val <- render value-  renderSumCondition name val+  renderSumCondition name (stext name <> indent 0 (parens ("{" <> val <> "}"))) renderSum (MultipleConstructors constrs) =   foldl1 (<$$>) <$> mapM renderSum constrs @@ -152,6 +151,11 @@     dx <- renderRef x     dy <- renderRef y     return $ "Json.Decode.tuple2" <> tupled [dx, dy]+  renderRef (RTuple3 x y z) = do+    dx <- renderRef x+    dy <- renderRef y+    dz <- renderRef z+    return $ "Json.Decode.tuple3" <> tupled [dx, dy, dz]   renderRef RUnit = pure "Json.Decode.nullAs"   renderRef RTimePosix = pure "Json.Decode.date"   renderRef RInt = pure "Json.Decode.int"
src/Reason/Encoder.hs view
@@ -58,35 +58,41 @@     dc <- mapM rndr constrs     return . nest 4 $ "switch(x)" <+> (braces $ line <> foldl1 (<$$>) dc) -jsonEncodeObject :: Doc -> Doc -> [Doc] -> Doc-jsonEncodeObject constructor tag contents =+jsonEncodeObject :: Doc -> Doc -> Either [(Doc,Doc)] Doc -> Doc+jsonEncodeObject constructor tag (Left []) =+  nest 4 $ "|" <+> constructor <$$> nest 4 ("Json.Encode.object_" <$$> parens (brackets (tag)))+jsonEncodeObject constructor tag (Left contents) =   nest 4 $ "|" <+> constructor <$$>     nest 4 ("Json.Encode.object_" <$$>             parens (brackets (tag <> comma <>                                (case contents of                                    [] -> empty-                                   _ -> foldl (\x y -> x <> line <> y <> comma) empty contents))))+                                   [(v,a)] -> line <> indent 2 (parens ("\"contents\"" <> comma <+> v <> parens a))+                                   _ -> line <> indent 2 (parens ("\"contents\"" <> comma <+> "Json.Encode.jsonArray([|"+                                               <$$> indent 2 (vcat (punctuate "," (map (\(r,a) -> r <> parens a) contents)))+                                               <$$> "|])"))))))+jsonEncodeObject constructor tag (Right contents) =+  nest 4 $ "|" <+> constructor <$$>+    nest 4 ("Json.Encode.object_" <$$>+            parens (brackets (tag <> comma <> contents)))  renderSum :: ReasonConstructor -> RenderM Doc-renderSum c@(NamedConstructor name ReasonEmpty) = do-  dc <- render c+renderSum (NamedConstructor name ReasonEmpty) = do   let cs = stext name <+> "=>"   let tag = pair (dquotes "tag") ("Json.Encode.string" <> parens (dquotes (stext name)))-  return $ jsonEncodeObject cs tag []-+  return $ jsonEncodeObject cs tag (Left []) renderSum (NamedConstructor name value) = do-  ps <- collectParameters 0 value-  let cs = stext name <> tupled (map fst ps) <+> "=>"+  ps <- collectParameters' 0 value+  let cs = stext name <> tupled (map snd ps) <+> "=>"   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)-+  return $ jsonEncodeObject cs tag (Left ps) renderSum (RecordConstructor name value) = do-  dv <- render value-  let cs = stext name <+> "=>"+  -- dv <- render value+  -- let ct = comma <+> dv+  ct <- renderFields value+  let cs = stext name <> parens (encloseSep "{" "}" "," (map (\(n,_,_) -> n) ct)) <+> "=>"   let tag = pair (dquotes "tag") (dquotes $ stext name)-  let ct = comma <+> dv-  return $ jsonEncodeObject cs tag [ct]-+  return $ jsonEncodeObject cs tag (Right (line <> indent 2 (vcat (punctuate "," (map (\(_,a,r) -> parens (dquotes a <> comma <+> r)) ct))))) renderSum (MultipleConstructors constrs) = do   dc <- mapM renderSum constrs   return $ foldl1 (<$+$>) dc@@ -94,14 +100,24 @@  renderEnumeration :: ReasonConstructor -> RenderM Doc renderEnumeration (NamedConstructor name _) =-  return . nest 4 $ "|" <+> stext name <+> "=>" <+>-      "Json.Encode.object_" <> parens (brackets (pair (dquotes "tag") ("Json.Encode.string" <> (parens (dquotes (stext name))))))+  return . nest 4 $ "|" <+> stext name <+> "=>" <+> "Json.Encode.string" <> (parens (dquotes (stext name))) renderEnumeration (MultipleConstructors constrs) = do   dc <- mapM renderEnumeration constrs   return $ foldl1 (<$$>) dc renderEnumeration c = render c  +renderFields :: ReasonValue -> RenderM [(Doc, Doc, Doc)]+renderFields (ReasonField name value) = do+    fieldModifier <- asks fieldLabelModifier+    valueBody <- render value+    pure $ [(stext name, stext (fieldModifier name), valueBody <> parens (stext name))]+renderFields (Values x y) = do+    dx <- renderFields x+    dy <- renderFields y+    pure $ dx ++ dy+renderFields _ = error "renderFields ReasonValue: should not happen"+ instance HasEncoder ReasonValue where   render (ReasonField name value) = do     fieldModifier <- asks fieldLabelModifier@@ -120,6 +136,7 @@   renderRef _ RTimePosix = pure $ "Json.Encode.date"   renderRef _ RUnit = pure "Json.Encode.null"   renderRef _ RInt = pure "Json.Encode.int"+  renderRef _ RInt64 = pure "Json.Encode.int"   renderRef _ RChar = pure "Json.Encode.char"   renderRef _ RBool = pure "Json.Encode.bool"   renderRef _ RFloat = pure "Json.Encode.float"@@ -135,6 +152,11 @@     dx <- renderRef (level + 1) x     dy <- renderRef (level + 1) y     return $ "Json.Encode.tuple2" <> tupled [dx, dy]+  renderRef level (RTuple3 x y z) = do+    dx <- renderRef (level + 1) x+    dy <- renderRef (level + 1) y+    dz <- renderRef (level + 1) z+    return $ "Json.Encode.tuple3" <> tupled [dx, dy, dz]   renderRef level (RMap k v) = do     dk <- renderRef level k     dv <- renderRef level v@@ -170,18 +192,6 @@ renderEncoder x = do   require "Json.Encode"   collectDeclaration . render . toReasonType $ x---- | Variable names for the members of constructors--- Used in pattern matches-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 $ [("arg" <> int i, r <> parens ("arg" <> int i))]  collectParameters' :: Int -> ReasonValue -> RenderM [(Doc,Doc)] collectParameters' _ ReasonEmpty = pure []
src/Reason/Record.hs view
@@ -59,7 +59,13 @@                                          empty else                                          parens dv)   render (MultipleConstructors constructors) =-    mintercalate (line <> "|" <> space) <$> sequence (render <$> constructors)+    mintercalate (line <> "|" <> space)+    <$> (mapM (\c -> case c of+                      RecordConstructor n _ -> do+                        r <- render c+                        pure $ stext n <+> indent 0 r+                      _ -> render c)+                   constructors)  instance HasType ReasonValue where   render (ReasonRef name) = pure (stextLower name)
test/ExportSpec.hs view
@@ -51,6 +51,8 @@ data Timing   = Start   | Continue Double+  | Continue2 Double Double+  | Continue3 { c3a :: Double, c3b :: Double }   | Stop   deriving (Generic, ReasonType)
test/MonstrosityDecoder.re view
@@ -2,17 +2,16 @@  let rec decodeMonstrosity = json =>     -        json |> (Json.Decode.field("type", Json.Decode.string)+        json |> (Json.Decode.field("tag", Json.Decode.string)             |> Json.Decode.andThen             ((x) => switch(x)             {-                | "NotSpecial" => json =>  NotSpecial-                | "OkayIGuess" => json =>  OkayIGuess(json |> Json.Decode.field("arg0"-                                                                               ,decodeMonstrosity))-                | "Ridiculous" => json =>  Ridiculous(json |> Json.Decode.field ("arg0"-                                                                                ,Json.Decode.int),-                json |> Json.Decode.field ("arg1"-                                          ,Json.Decode.string),-                json |> Json.Decode.field ("arg2"-                                          ,Json.Decode.list(decodeMonstrosity)),)+                | "NotSpecial" => json => NotSpecial+                | "OkayIGuess" => json => OkayIGuess(json |> Json.Decode.field("contents", decodeMonstrosity))+                | "Ridiculous" => json => (((arg0+                                            ,arg1)) => Ridiculous(arg0+                                                                 ,arg1+                                                                 ,arg2))(json |> Json.Decode.tuple3(Json.Decode.int+                                                                                                   ,Json.Decode.string+                                                                                                   ,Json.Decode.list(decodeMonstrosity)))                 | _ => failwith("unknown constructor")}))
test/MonstrosityEncoder.re view
@@ -4,15 +4,17 @@     switch(x) {         | NotSpecial =>             Json.Encode.object_-                ([( "tag", Json.Encode.string("NotSpecial") ),])+                ([( "tag", Json.Encode.string("NotSpecial") )])         | OkayIGuess(arg0) =>             Json.Encode.object_                 ([( "tag", Json.Encode.string("OkayIGuess") ),-                    ( "arg0", encodeMonstrosity(arg0) ),])+                  ("contents", encodeMonstrosity(arg0))])          | Ridiculous(arg0,arg1,arg2) =>             Json.Encode.object_                 ([( "tag", Json.Encode.string("Ridiculous") ),-                    ( "arg0", Json.Encode.int(arg0) ),-                    ( "arg1", Json.Encode.string(arg1) ),-                    ( "arg2", (Json.Encode.list(encodeMonstrosity))(arg2) ),])}+                  ("contents", Json.Encode.jsonArray([|+                    Json.Encode.int(arg0),+                    Json.Encode.string(arg1),+                    (Json.Encode.list(encodeMonstrosity))(arg2)+                  |]))])}
test/PositionDecoder.re view
@@ -2,11 +2,11 @@  let rec decodePosition = json =>     -        json |> (Json.Decode.field("type", Json.Decode.string)+        json |> (Json.Decode.string             |> Json.Decode.andThen             ((x) => switch(x)             {-                | "Beginning" => json =>  Beginning-                | "Middle" => json =>  Middle-                | "End" => json =>  End+                | "Beginning" => json => Beginning+                | "Middle" => json => Middle+                | "End" => json => End                 | _ => failwith("unknown constructor")}))
test/PositionEncoder.re view
@@ -2,6 +2,6 @@  let rec encodePosition  = (x : position) =>     switch(x) {-        | 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") )])}+        | Beginning => Json.Encode.string("Beginning")+        | Middle => Json.Encode.string("Middle")+        | End => Json.Encode.string("End")}
test/TimingDecoder.re view
@@ -2,12 +2,19 @@  let rec decodeTiming = json =>     -        json |> (Json.Decode.field("type", Json.Decode.string)+        json |> (Json.Decode.field("tag", Json.Decode.string)             |> Json.Decode.andThen             ((x) => switch(x)             {-                | "Start" => json =>  Start-                | "Continue" => json =>  Continue(json |> Json.Decode.field("arg0"-                                                                           ,Json.Decode.float))-                | "Stop" => json =>  Stop+                | "Start" => json => Start+                | "Continue" => json => Continue(json |> Json.Decode.field("contents", Json.Decode.float))+                | "Continue2" => json => (((arg0+                                           ,arg1)) => Continue2(arg0+                                                               ,arg1))(json |> Json.Decode.tuple2(Json.Decode.float+                                                                                                 ,Json.Decode.float))+                | "Continue3" => json => Continue3({c3a : json |> Json.Decode.field ("c3a"+                                                                                    ,Json.Decode.float),+                                                  c3b : json |> Json.Decode.field ("c3b"+                                                                                  ,Json.Decode.float),})+                | "Stop" => json => Stop                 | _ => failwith("unknown constructor")}))
test/TimingEncoder.re view
@@ -4,12 +4,26 @@     switch(x) {         | Start =>             Json.Encode.object_-                ([( "tag", Json.Encode.string("Start") ),])+                ([( "tag", Json.Encode.string("Start") )])+         | Continue(arg0) =>             Json.Encode.object_                 ([( "tag", Json.Encode.string("Continue") ),-                    ( "arg0", Json.Encode.float(arg0) ),])+                  ("contents", Json.Encode.float(arg0))])+        | Continue2(arg0,arg1) =>+            Json.Encode.object_+                ([( "tag", Json.Encode.string("Continue2") ),+                  ("contents", Json.Encode.jsonArray([|+                    Json.Encode.float(arg0),+                    Json.Encode.float(arg1)+                  |]))]) +        | Continue3({c3a,c3b}) =>+            Json.Encode.object_+                ([( "tag", "Continue3" ),+                  ("c3a", Json.Encode.float(c3a)),+                  ("c3b", Json.Encode.float(c3b))])+         | Stop =>             Json.Encode.object_-                ([( "tag", Json.Encode.string("Stop") ),])}+                ([( "tag", Json.Encode.string("Stop") )])}
test/TimingType.re view
@@ -1,4 +1,8 @@ type timing =     | Start     | Continue(float)+    | Continue2(float, float)+    | Continue3 { c3a : float+                , c3b : float+                }     | Stop