reason-export (empty) → 0.1.0.0
raw patch · 48 files changed
+1967/−0 lines, 48 filesdep +Diffdep +HUnitdep +QuickChecksetup-changed
Dependencies added: Diff, HUnit, QuickCheck, base, bytestring, containers, directory, formatting, hashable, hspec, hspec-core, mtl, quickcheck-instances, reason-export, text, time, wl-pprint-text
Files
- ChangeLog.md +3/−0
- LICENSE +18/−0
- README.md +68/−0
- Setup.hs +2/−0
- reason-export.cabal +114/−0
- src/Reason.hs +12/−0
- src/Reason/Common.hs +95/−0
- src/Reason/Decoder.hs +165/−0
- src/Reason/Encoder.hs +185/−0
- src/Reason/File.hs +65/−0
- src/Reason/Record.hs +153/−0
- src/Reason/Type.hs +214/−0
- test/CommentDecoder.re +20/−0
- test/CommentDecoderWithOptions.re +20/−0
- test/CommentEncoder.re +13/−0
- test/CommentEncoderWithOptions.re +13/−0
- test/CommentType.re +10/−0
- test/CommentTypeWithOptions.re +10/−0
- test/ExportSpec.hs +554/−0
- test/FavoritePlacesType.re +6/−0
- test/MonstrosityDecoder.re +18/−0
- test/MonstrosityEncoder.re +18/−0
- test/MonstrosityType.re +4/−0
- test/PositionDecoder.re +12/−0
- test/PositionEncoder.re +7/−0
- test/PositionType.re +4/−0
- test/PostDecoder.re +17/−0
- test/PostDecoderWithOptions.re +17/−0
- test/PostEncoder.re +12/−0
- test/PostEncoderWithOptions.re +12/−0
- test/PostType.re +10/−0
- test/PostTypeWithOptions.re +10/−0
- test/ShadowingDecoder.re +9/−0
- test/ShadowingEncoder.re +9/−0
- test/ShadowingType.re +3/−0
- test/Spec.hs +1/−0
- test/TimingDecoder.re +13/−0
- test/TimingEncoder.re +15/−0
- test/TimingType.re +4/−0
- test/UnitDecoder.re +4/−0
- test/UnitEncoder.re +4/−0
- test/UnitType.re +2/−0
- test/UselessDecoder.re +4/−0
- test/UselessEncoder.re +4/−0
- test/UselessType.re +2/−0
- test/WrapperDecoder.re +5/−0
- test/WrapperEncoder.re +5/−0
- test/WrapperType.re +2/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for reason-export++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,18 @@+Copyright 2019 Andrei Barbu++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,68 @@+# Reason Export++[](https://travis-ci.org/abarbu/reason-export)+<img src="https://cdn.svgporn.com/logos/reasonml.svg" alt="reason" height="20"/>+<img src="https://www.haskell.org/img/haskell-logo.svg" alt="reason" height="20"/>++Create Reason classes and JSON encoders/decoders from Haskell DataTypes.+Originally build by converting [elm-export](http://hackage.haskell.org/package/elm-export) to Reason.++More docs on [Hackage](http://hackage.haskell.org/package/reason-export).++## Usage++If you're using this package you almost certainly want to use [servant-reason](http://hackage.haskell.org/package/servant-reason) as well. There are tests in both packages+that show to use this library.++Usage is trivial, derive `Generic` and `ReasonType`.++```haskell+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}++module Db where++import Reason+import GHC.Generics++data Person = Person+ { id :: Int+ , name :: Maybe String+ } deriving (Show, Eq, Generic, ReasonType)+```++Then you can expose your API:++```haskell+module Main where++import Data.Proxy+import Reason+import Data.Text hiding (intercalate, map)+import Db++main :: IO ()+main = do+ let code = defReasonImports :+ toReasonTypeSource (Proxy :: Proxy Person) :+ toReasonDecoderSource (Proxy :: Proxy Person) :+ writeFile "client/Types.re" $ intercalate "\n\n" $ map unpack code+```++That's about it. Just do this for every type that you want to expose. You can make encoders as well, and configure various settings. See [Hackage](http://hackage.haskell.org/package/reason-export).++## Reason setup++The generated Reason code needs access to [@glennsl/bs-json](https://github.com/glennsl/bs-json). Get the latest install instructions from there, but at the time of writing these were:++```sh+npm install --save @glennsl/bs-json+```++Then add `@glennsl/bs-json` to `bs-dependencies` in your `bsconfig.json`:+```js+{+ ...+ "bs-dependencies": ["@glennsl/bs-json"]+}+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ reason-export.cabal view
@@ -0,0 +1,114 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: 06d199b5f88dc43f668e59c63a8b8ace8d65cb76a08af2fbf3edeb41d0ba624e++name: reason-export+version: 0.1.0.0+synopsis: Generate Reason types from Haskell+description: Please see the README on GitHub at <https://github.com/abarbu/reason-export#readme>+category: Web+homepage: https://github.com/abarbu/reason-export#readme+bug-reports: https://github.com/abarbu/reason-export/issues+author: Andrei Barbu+maintainer: andrei@0xab.com+copyright: 2019 Andrei Barbu+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md+ test/CommentDecoder.re+ test/CommentDecoderWithOptions.re+ test/CommentEncoder.re+ test/CommentEncoderWithOptions.re+ test/CommentType.re+ test/CommentTypeWithOptions.re+ test/FavoritePlacesType.re+ test/MonstrosityDecoder.re+ test/MonstrosityEncoder.re+ test/MonstrosityType.re+ test/PositionDecoder.re+ test/PositionEncoder.re+ test/PositionType.re+ test/PostDecoder.re+ test/PostDecoderWithOptions.re+ test/PostEncoder.re+ test/PostEncoderWithOptions.re+ test/PostType.re+ test/PostTypeWithOptions.re+ test/ShadowingDecoder.re+ test/ShadowingEncoder.re+ test/ShadowingType.re+ test/TimingDecoder.re+ test/TimingEncoder.re+ test/TimingType.re+ test/UnitDecoder.re+ test/UnitEncoder.re+ test/UnitType.re+ test/UselessDecoder.re+ test/UselessEncoder.re+ test/UselessType.re+ test/WrapperDecoder.re+ test/WrapperEncoder.re+ test/WrapperType.re++source-repository head+ type: git+ location: https://github.com/abarbu/reason-export++library+ exposed-modules:+ Reason+ other-modules:+ Reason.Common+ Reason.Decoder+ Reason.Encoder+ Reason.File+ Reason.Record+ Reason.Type+ Paths_reason_export+ hs-source-dirs:+ src+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <5+ , bytestring+ , containers+ , directory+ , formatting+ , hashable+ , mtl+ , text+ , time+ , wl-pprint-text+ default-language: Haskell2010++test-suite reason-export-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ ExportSpec+ Paths_reason_export+ hs-source-dirs:+ test+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ Diff+ , HUnit+ , QuickCheck+ , base >=4.7 && <5+ , bytestring+ , containers+ , hashable+ , hspec+ , hspec-core+ , quickcheck-instances+ , reason-export+ , text+ , time+ default-language: Haskell2010
+ src/Reason.hs view
@@ -0,0 +1,12 @@+{-| Generate Reason types, JSON decoders & JSON encoders from Haskell datatypes.+-}+module Reason+ ( module X+ ) where++import Reason.Common as X (Options(..), defaultOptions, require)+import Reason.Decoder as X+import Reason.Encoder as X+import Reason.File as X+import Reason.Record as X+import Reason.Type as X
+ src/Reason/Common.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings #-}++module Reason.Common where++import Control.Monad.RWS+import Data.Set (Set)+import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Char as C+import qualified Data.Text.Lazy as LT+import Formatting hiding (text)+import Text.PrettyPrint.Leijen.Text hiding ((<$>))++data Options = Options+ { fieldLabelModifier :: Text -> Text+ }++defaultOptions :: Options+defaultOptions = Options {fieldLabelModifier = id}++cr :: Format r r+cr = now "\n"++mintercalate+ :: Monoid m+ => m -> [m] -> m+mintercalate _ [] = mempty+mintercalate _ [x] = x+mintercalate seperator (x:xs) = x <> seperator <> mintercalate seperator xs++pprinter :: Doc -> Text+pprinter = LT.toStrict . displayT . renderPretty 0.4 100++stext :: Data.Text.Text -> Doc+stext = text . LT.fromStrict++stextLower :: Data.Text.Text -> Doc+stextLower = text . LT.fromStrict . (\x -> C.toLower (T.head x) `T.cons` T.tail x)++stextLowerSuffix :: Data.Text.Text -> Data.Text.Text -> Doc+stextLowerSuffix suffix = text . LT.fromStrict . (\x -> C.toLower (T.head x) `T.cons` T.tail x `T.append` suffix)++stextSuffix :: Data.Text.Text -> Data.Text.Text -> Doc+stextSuffix suffix = text . LT.fromStrict . (`T.append` suffix)++spaceparens :: Doc -> Doc+spaceparens doc = "(" <+> doc <+> ")"++-- | Parentheses of which the right parenthesis exists on a new line+newlineparens :: Doc -> Doc+newlineparens doc = "(" <> doc <$$> ")"++-- | An empty line, regardless of current indentation+emptyline :: Doc+emptyline = nest minBound linebreak++-- | Like <$$>, but with an empty line in between+(<$+$>) :: Doc -> Doc -> Doc+l <$+$> r = l <> emptyline <$$> r++-- TODO Replace require / imports everywhere!++--+type RenderM = RWS Options (Set Text -- The set of instances+ , [Text] -- Generated declarations+ ) (Maybe Text) -- The type of the current module++{-| Add an instance to the set.+-}+require :: Text -> RenderM ()+require dep = tell (S.singleton dep, [])++{-| Take the result of a RenderM computation and put it into the Writer's+declarations.+-}+collectDeclaration :: RenderM Doc -> RenderM ()+collectDeclaration =+ mapRWS ((\(defn, s, (imports, _)) -> ((), s, (imports, [pprinter defn]))))++squarebracks :: Doc -> Doc+squarebracks doc = "[" <+> doc <+> "]"++pair :: Doc -> Doc -> Doc+pair l r = spaceparens $ l <> comma <+> r++reservedKeywords :: [T.Text]+reservedKeywords = ["and","as","assertbegin","constraint","done","downto","end"+ ,"exception","external","for","fun","function","functor","in","include"+ ,"inherit","initializer","let","match","method","module","mutable","of"+ ,"open","or","struct","to","true","try","type","virtual","while","with"]++maybeReserved :: T.Text -> T.Text+maybeReserved name | name `elem` reservedKeywords = name <> "_"+ | otherwise = name
+ src/Reason/Decoder.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}++module Reason.Decoder+ ( toReasonDecoderRef+ , toReasonDecoderRefWith+ , toReasonDecoderSource+ , toReasonDecoderSourceWith+ , renderDecoder+ ) where++import Control.Monad.RWS+import qualified Data.Text as T+import Reason.Common+import Reason.Type+import Text.PrettyPrint.Leijen.Text hiding ((<$>))++class HasDecoder a where+ render :: a -> RenderM Doc++class HasDecoderRef a where+ renderRef :: a -> RenderM Doc++instance HasDecoder ReasonDatatype where+ render d@(ReasonDatatype _ constructor) = do+ fnName <- renderRef d+ ctor <- render constructor+ return $ "let rec" <+> fnName <+> "= json =>" <$$> indent 4 ctor+ render (ReasonPrimitive primitive) = renderRef primitive++instance HasDecoderRef ReasonDatatype where+ renderRef (ReasonDatatype name _) = pure $ "decode" <> stext name+ renderRef (ReasonPrimitive primitive) = renderRef primitive++instance HasDecoder ReasonConstructor where+ render (NamedConstructor name ReasonEmpty) =+ 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) = do+ (_, 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+ <> indent 4+ ("json |>" <+> parens+ (constructorName <$$> 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)++-- | 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 value) = do+ val <- render value+ renderSumCondition name $ "json |> Json.Decode.field" <> tupled [dquotes "arg0", val]+renderSum (RecordConstructor name value) = do+ val <- render value+ renderSumCondition name val+renderSum (MultipleConstructors constrs) =+ foldl1 (<$$>) <$> mapM renderSum constrs++-- | Render the decoding of a constructor's arguments. Note the constructor must+-- be from a data type with multiple constructors and that it has multiple+-- constructors itself.+renderConstructorArgs :: Int -> ReasonValue -> RenderM (Int, 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, "json |> Json.Decode.field" <+> tupled [dquotes ("arg" <> int i), rndrVal] <> comma)++instance HasDecoder ReasonValue where+ render (ReasonRef name) = pure $ "decode" <> stext name+ render (ReasonPrimitiveRef primitive) = renderRef primitive+ render (Values x y) = do+ dx <- render x+ dy <- render y+ return $ dx <$$> dy+ render (ReasonField name value) = do+ fieldModifier <- asks fieldLabelModifier+ dv <- render value+ -- return $ "|> required" <+> dquotes (stext (fieldModifier name)) <+> dv+ return $ (stext (fieldModifier name)) <+> ":" <+> "json |> Json.Decode.field" <+> tupled [dquotes (stext (fieldModifier name)), dv] <> comma+ render ReasonEmpty = pure (stext "")++instance HasDecoderRef ReasonPrimitive where+ renderRef (RList (ReasonPrimitive RChar)) = pure "Json.Decode.string"+ renderRef (RList datatype) = do+ dt <- renderRef datatype+ return $ "Json.Decode.list" <> parens dt+ renderRef (RMap key value) = do+ k <- renderRef key+ d <- renderRef value+ let kname = primitiveName key+ return $ "Json.Decode.map" <> tupled ["l => List.fold_left" <+> tupled ["(m,(k,v)) =>" <+> "Map_" <> stext kname <> ".add(k,v,m)"+ ,"Map_" <> stext kname <> ".empty"+ ,"l"]+ ,"Json.Decode.list(Json.Decode.tuple2(" <> k <> "," <> d <> "))"]+ renderRef (ROption datatype) = do+ dt <- renderRef datatype+ return $ "Json.Decode.optional" <> parens dt+ renderRef (RTuple2 x y) = do+ dx <- renderRef x+ dy <- renderRef y+ return $ "Json.Decode.tuple2" <> tupled [dx, dy]+ renderRef RUnit = pure "Json.Decode.nullAs"+ renderRef RTimePosix = pure "Json.Decode.date"+ renderRef RInt = pure "Json.Decode.int"+ renderRef RBool = pure "Json.Decode.bool"+ renderRef RChar = pure "Json.Decode.char"+ renderRef RFloat = pure "Json.Decode.float"+ renderRef RString = pure "Json.Decode.string"++toReasonDecoderRefWith+ :: ReasonType a+ => Options -> a -> T.Text+toReasonDecoderRefWith options x =+ pprinter . fst $ evalRWS (renderRef (toReasonType x)) options Nothing++toReasonDecoderRef+ :: ReasonType a+ => a -> T.Text+toReasonDecoderRef = toReasonDecoderRefWith defaultOptions++toReasonDecoderSourceWith+ :: ReasonType a+ => Options -> a -> T.Text+toReasonDecoderSourceWith options x =+ pprinter . fst $ evalRWS (render (toReasonType x)) options Nothing++toReasonDecoderSource+ :: ReasonType a+ => a -> T.Text+toReasonDecoderSource = toReasonDecoderSourceWith defaultOptions++renderDecoder+ :: ReasonType a+ => a -> RenderM ()+renderDecoder x = do+ collectDeclaration . render . toReasonType $ x
+ src/Reason/Encoder.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE OverloadedStrings #-}++module Reason.Encoder+ ( toReasonEncoderRef+ , toReasonEncoderRefWith+ , toReasonEncoderSource+ , toReasonEncoderSourceWith+ , renderEncoder+ ) where++import Control.Monad.RWS+import qualified Data.Text as T+import Reason.Common+import Reason.Type+import Text.PrettyPrint.Leijen.Text hiding ((<$>))++class HasEncoder a where+ render :: a -> RenderM Doc++class HasEncoderRef a where+ renderRef :: Int -> a -> RenderM Doc++instance HasEncoder ReasonDatatype where+ render d@(ReasonDatatype name constructor) = do+ fnName <- renderRef 0 d+ ctor <- render constructor+ return $ ("let rec" <+> fnName <+> " = (x : " <> stextLower name <> ")" <+> "=>" <$$> indent 4 ctor)+ render (ReasonPrimitive primitive) = renderRef 0 primitive++instance HasEncoderRef ReasonDatatype where+ renderRef _ (ReasonDatatype name _) = pure $ "encode" <> stext name+ renderRef level (ReasonPrimitive primitive) = renderRef level primitive++instance HasEncoder ReasonConstructor where+ -- Single constructor, no values: empty array+ render (NamedConstructor _name ReasonEmpty) =+ return $ "Json.Encode.null"+ render (NamedConstructor _name (ReasonPrimitiveRef RUnit)) =+ 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 <$$> "]"))+ -- Single constructor, one value: skip constructor and r just the value+ render (NamedConstructor name value) = do+ dv <- render value+ let cs = "|" <+> stext name <> parens "y0" <+> "=>"+ return $ nest 4 $ "switch(x)" <+> (braces $ line <> cs <+> nest 4 (nest 4 dv <> parens "y0"))+ render (RecordConstructor _ value) = do+ dv <- render value+ return . nest 4 $ "Json.Encode.object_" <$$> parens ("[" <+> dv <$$> "]")+ render mc@(MultipleConstructors constrs) = do+ let rndr = if isEnumeration mc then renderEnumeration else renderSum+ dc <- mapM rndr constrs+ return . nest 4 $ "switch(x)" <+> (braces $ line <> foldl1 (<$$>) dc)++jsonEncodeObject :: Doc -> Doc -> [Doc] -> Doc+jsonEncodeObject constructor tag 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))))++renderSum :: ReasonConstructor -> RenderM Doc+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)))+ 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'+ 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 ct = comma <+> dv+ return $ jsonEncodeObject cs tag [ct]++renderSum (MultipleConstructors constrs) = do+ dc <- mapM renderSum constrs+ return $ foldl1 (<$+$>) dc+++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))))))+renderEnumeration (MultipleConstructors constrs) = do+ dc <- mapM renderEnumeration constrs+ return $ foldl1 (<$$>) dc+renderEnumeration c = render c+++instance HasEncoder ReasonValue where+ render (ReasonField name value) = do+ fieldModifier <- asks fieldLabelModifier+ valueBody <- render value+ return . spaceparens $+ dquotes (stext (fieldModifier name)) <> comma <+> (valueBody <> parens ("x." <> stext (fieldModifier name)))+ render (ReasonPrimitiveRef primitive) = renderRef 0 primitive+ render (ReasonRef name) = pure $ "encode" <> stext name+ render (Values x y) = do+ dx <- render x+ dy <- render y+ return $ dx <$$> comma <+> dy+ render _ = error "HasEncoderRef ReasonValue: should not happen"++instance HasEncoderRef ReasonPrimitive where+ renderRef _ RTimePosix = pure $ "Json.Encode.date"+ renderRef _ RUnit = pure "Json.Encode.null"+ renderRef _ RInt = pure "Json.Encode.int"+ renderRef _ RChar = pure "Json.Encode.char"+ renderRef _ RBool = pure "Json.Encode.bool"+ renderRef _ RFloat = pure "Json.Encode.float"+ renderRef _ RString = pure "Json.Encode.string"+ renderRef _ (RList (ReasonPrimitive RChar)) = pure "Json.Encode.string"+ renderRef level (RList datatype) = do+ dd <- renderRef level datatype+ return . parens $ "Json.Encode.list" <> parens dd+ renderRef level (ROption datatype) = do+ dd <- renderRef level datatype+ return . parens $ "Json.Encode.nullable" <> parens dd+ renderRef level (RTuple2 x y) = do+ dx <- renderRef (level + 1) x+ dy <- renderRef (level + 1) y+ return $ "Json.Encode.tuple2" <> tupled [dx, dy]+ renderRef level (RMap k v) = do+ dk <- renderRef level k+ dv <- renderRef level v+ let kname = primitiveName k+ return $ parens $ "(x) =>" <+> "Json.Encode.list" <> parens ("Json.Encode.tuple2" <> tupled [dk, dv])+ <> parens ("Map_" <> stext kname <> ".bindings(x)")++toReasonEncoderRefWith+ :: ReasonType a+ => Options -> a -> T.Text+toReasonEncoderRefWith options x =+ pprinter . fst $ evalRWS (renderRef 0 (toReasonType x)) options Nothing++toReasonEncoderRef+ :: ReasonType a+ => a -> T.Text+toReasonEncoderRef = toReasonEncoderRefWith defaultOptions++toReasonEncoderSourceWith+ :: ReasonType a+ => Options -> a -> T.Text+toReasonEncoderSourceWith options x =+ pprinter . fst $ evalRWS (render (toReasonType x)) options Nothing++toReasonEncoderSource+ :: ReasonType a+ => a -> T.Text+toReasonEncoderSource = toReasonEncoderSourceWith defaultOptions++renderEncoder+ :: ReasonType a+ => a -> RenderM ()+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))]
+ src/Reason/File.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}++module Reason.File+ ( Spec(..)+ , specsToDir+ , moduleSpec+ , moduleSpecWith+ ) where++import Control.Monad.RWS+import Data.List+import qualified Data.Set as S+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Reason.Common+import Formatting as F+import System.Directory++makePath :: [Text] -> Text+makePath = T.intercalate "/"++data Spec = Spec+ { namespace :: [Text]+ , declarations :: [Text]+ } deriving (Eq, Show)++pathForSpec :: FilePath -> Spec -> [Text]+pathForSpec rootDir spec = T.pack rootDir : namespace spec++ensureDirectory :: FilePath -> Spec -> IO ()+ensureDirectory rootDir spec =+ let dir = makePath . Data.List.init $ pathForSpec rootDir spec+ in createDirectoryIfMissing True (T.unpack dir)++specToFile :: FilePath -> Spec -> IO ()+specToFile rootDir spec =+ let path = pathForSpec rootDir spec+ file = makePath path <> ".rs"+ namespaceText = T.intercalate "." (namespace spec)+ body =+ T.intercalate+ "\n\n"+ (sformat ("module " % F.stext % " exposing (..)") namespaceText :+ declarations spec)+ in do fprint ("Writing: " % F.stext % "\n") file+ T.writeFile (T.unpack file) body++specsToDir :: [Spec] -> FilePath -> IO ()+specsToDir specs rootDir = mapM_ processSpec specs+ where+ processSpec = ensureDirectory rootDir >> specToFile rootDir++moduleSpecWith :: Options -> [Text] -> RenderM () -> Spec+moduleSpecWith options ns m =+ let (_, (imports, defns)) = execRWS m options Nothing+ in Spec+ { namespace = ns+ , declarations =+ (T.intercalate "\n" . fmap ("import " <>) . S.toAscList $ imports) :+ defns+ }++moduleSpec :: [Text] -> RenderM () -> Spec+moduleSpec = moduleSpecWith defaultOptions
+ src/Reason/Record.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE OverloadedStrings #-}++module Reason.Record+ ( toReasonTypeRef+ , toReasonTypeRefWith+ , toReasonTypeSource+ , toReasonTypeSourceWith+ , renderType+ ) where++import Control.Monad.RWS+import qualified Data.Text as T+import Reason.Common+import Reason.Type+import Text.PrettyPrint.Leijen.Text hiding ((<$>))++class HasType a where+ render :: a -> RenderM Doc++class HasRecordType a where+ renderRecord :: a -> RenderM Doc++class HasTypeRef a where+ renderRef :: a -> RenderM Doc++instance HasType ReasonDatatype where+ render d@(ReasonDatatype name constructor@(RecordConstructor _ _)) = do+ put $ Just name+ name' <- renderRef d+ ctor <- render constructor+ return . nest 4 $ "type" <+> name' <+> "=" <$$> ctor+ render d@(ReasonDatatype name constructor) = do+ put $ Just name+ name' <- renderRef d+ ctor <- render constructor+ return . nest 4 $ "type" <+> name' <+> "=" <$$> ("|" <> space <> ctor)+ render (ReasonPrimitive primitive) = renderRef primitive++namespaceIfNeeded :: T.Text -> T.Text -> RenderM Doc+namespaceIfNeeded typeName obj = do+ currentName <- get+ case currentName of+ Nothing -> pure (stextSuffix ("." <> obj) (typeName <> "Type"))+ Just cn -> if cn == typeName then+ pure "t" else+ pure (stextSuffix ("." <> obj) (typeName <> "Type"))++instance HasTypeRef ReasonDatatype where+ renderRef (ReasonDatatype typeName _) = pure (stextLower typeName) -- namespaceIfNeeded typeName "t"+ renderRef (ReasonPrimitive primitive) = renderRef primitive++instance HasType ReasonConstructor where+ render (RecordConstructor _ value) = do+ dv <- renderRecord value+ return $ "{" <+> dv <$$> "}"+ render (NamedConstructor constructorName value) = do+ dv <- render value+ return $ stext constructorName <> (if isEmpty dv then+ empty else+ parens dv)+ render (MultipleConstructors constructors) =+ mintercalate (line <> "|" <> space) <$> sequence (render <$> constructors)++instance HasType ReasonValue where+ render (ReasonRef name) = pure (stextLower name)+ render (ReasonPrimitiveRef primitive) = elmRefParens primitive <$> renderRef primitive+ render ReasonEmpty = pure (text "")+ render (Values x y) = do+ dx <- render x+ dy <- render y+ return $ dx <> "," <+> dy+ render (ReasonField name value) = do+ fieldModifier <- asks fieldLabelModifier+ dv <- renderRecord value+ return $ stext (fieldModifier (maybeReserved name)) <+> ":" <+> dv++instance HasRecordType ReasonValue where+ renderRecord (ReasonPrimitiveRef primitive) = renderRef primitive+ renderRecord (Values x y) = do+ dx <- renderRecord x+ dy <- renderRecord y+ return $ dx <$$> comma <+> dy+ renderRecord value = render value++instance HasTypeRef ReasonPrimitive where+ renderRef (RList (ReasonPrimitive RChar)) = renderRef RString+ renderRef (RList datatype) = do+ dt <- renderRef datatype+ return $ "list" <+> parens dt+ renderRef (RTuple2 x y) = do+ dx <- renderRef x+ dy <- renderRef y+ return . parens $ dx <> comma <+> dy+ renderRef (RTuple3 x y z) = do+ dx <- renderRef x+ dy <- renderRef y+ dz <- renderRef z+ return . parens $ dx <> comma <+> dy <+> comma <+> dz+ renderRef (ROption datatype) = do+ dt <- renderRef datatype+ return $ "option" <+> parens dt+ renderRef (RMap k v) = do+ dk <- renderRef k+ let kname = primitiveName k+ require ("module Map_" <> kname -- displayTStrict (renderCompact dk)+ <> " = Map.Make({ type t = "+ <> displayTStrict (renderCompact dk)+ <> "; let compare = compare });")+ dv <- renderRef v+ return $ "Map_" <> stext kname <> ".t" <+> parens dv+ renderRef RInt = pure "int"+ renderRef RInt64 = pure "int64"+ renderRef RTimePosix = pure "Js.Date.t"+ renderRef RBool = pure "bool"+ renderRef RChar = pure "char"+ renderRef RString = pure "string"+ renderRef RUnit = pure ""+ renderRef RFloat = pure "float"++-- | Puts parentheses around the doc of an elm ref if it contains spaces.+elmRefParens :: ReasonPrimitive -> Doc -> Doc+elmRefParens (RList (ReasonPrimitive RChar)) = id+elmRefParens (RList _) = parens+elmRefParens (ROption _) = parens+elmRefParens (RMap _ _) = parens+elmRefParens _ = id++toReasonTypeRefWith+ :: ReasonType a+ => Options -> a -> T.Text+toReasonTypeRefWith options x =+ pprinter . fst $ evalRWS (renderRef (toReasonType x)) options Nothing++toReasonTypeRef+ :: ReasonType a+ => a -> T.Text+toReasonTypeRef = toReasonTypeRefWith defaultOptions++toReasonTypeSourceWith+ :: ReasonType a+ => Options -> a -> T.Text+toReasonTypeSourceWith options x =+ pprinter . fst $ evalRWS (render (toReasonType x)) options Nothing++toReasonTypeSource+ :: ReasonType a+ => a -> T.Text+toReasonTypeSource = toReasonTypeSourceWith defaultOptions++renderType+ :: ReasonType a+ => a -> RenderM ()+renderType = collectDeclaration . render . toReasonType
+ src/Reason/Type.hs view
@@ -0,0 +1,214 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}++module Reason.Type where++import Data.Int (Int16, Int32, Int64, Int8)+import Data.IntMap+import Data.Map+import Data.Proxy+import Data.Text hiding (all)+import Data.Time+import GHC.Generics+import Prelude+import Data.Hashable(hash)++data ReasonDatatype+ = ReasonDatatype Text ReasonConstructor+ | ReasonPrimitive ReasonPrimitive+ deriving (Show, Eq)++data ReasonPrimitive+ = RInt+ | RInt64+ | RFloat+ | RBool+ | RChar+ | RString+ | RTimePosix+ | RUnit+ | RList ReasonDatatype+ | ROption ReasonDatatype+ | RTuple2 ReasonDatatype ReasonDatatype+ | RTuple3 ReasonDatatype ReasonDatatype ReasonDatatype+ | RMap ReasonPrimitive ReasonDatatype+ deriving (Show, Eq)++data ReasonConstructor+ = NamedConstructor Text ReasonValue+ | RecordConstructor Text ReasonValue+ | MultipleConstructors [ReasonConstructor]+ deriving (Show, Eq)++data ReasonValue+ = ReasonRef Text+ | ReasonEmpty+ | ReasonPrimitiveRef ReasonPrimitive+ | Values ReasonValue ReasonValue+ | ReasonField Text ReasonValue+ deriving (Show, Eq)++------------------------------------------------------------+class ReasonType a where+ toReasonType :: a -> ReasonDatatype+ toReasonType = genericToReasonDatatype . from+ default toReasonType :: (Generic a, GenericReasonDatatype (Rep a)) =>+ a -> ReasonDatatype++------------------------------------------------------------+class GenericReasonDatatype f where+ genericToReasonDatatype :: f a -> ReasonDatatype++instance (Datatype d, GenericReasonConstructor f) =>+ GenericReasonDatatype (D1 d f) where+ genericToReasonDatatype datatype =+ ReasonDatatype+ (pack (datatypeName datatype))+ (genericToReasonConstructor (unM1 datatype))++------------------------------------------------------------+class GenericReasonConstructor f where+ genericToReasonConstructor :: f a -> ReasonConstructor++instance (Constructor c, GenericReasonValue f) =>+ GenericReasonConstructor (C1 c f) where+ genericToReasonConstructor constructor =+ if conIsRecord constructor+ then RecordConstructor name (genericToReasonValue (unM1 constructor))+ else NamedConstructor name (genericToReasonValue (unM1 constructor))+ where+ name = pack $ conName constructor++instance (GenericReasonConstructor f, GenericReasonConstructor g) =>+ GenericReasonConstructor (f :+: g) where+ genericToReasonConstructor _ =+ MultipleConstructors+ [ genericToReasonConstructor (undefined :: f p)+ , genericToReasonConstructor (undefined :: g p)+ ]++------------------------------------------------------------+class GenericReasonValue f where+ genericToReasonValue :: f a -> ReasonValue++instance (Selector s, GenericReasonValue a) =>+ GenericReasonValue (S1 s a) where+ genericToReasonValue selector =+ case selName selector of+ "" -> genericToReasonValue (undefined :: a p)+ name -> ReasonField (pack name) (genericToReasonValue (undefined :: a p))++instance (GenericReasonValue f, GenericReasonValue g) =>+ GenericReasonValue (f :*: g) where+ genericToReasonValue _ =+ Values+ (genericToReasonValue (undefined :: f p))+ (genericToReasonValue (undefined :: g p))++instance GenericReasonValue U1 where+ genericToReasonValue _ = ReasonEmpty++instance ReasonType a =>+ GenericReasonValue (Rec0 a) where+ genericToReasonValue _ =+ case toReasonType (Proxy :: Proxy a) of+ ReasonPrimitive primitive -> ReasonPrimitiveRef primitive+ ReasonDatatype name _ -> ReasonRef name++instance ReasonType a =>+ ReasonType [a] where+ toReasonType _ = ReasonPrimitive (RList (toReasonType (Proxy :: Proxy a)))++instance ReasonType a =>+ ReasonType (Maybe a) where+ toReasonType _ = ReasonPrimitive (ROption (toReasonType (Proxy :: Proxy a)))++instance ReasonType () where+ toReasonType _ = ReasonPrimitive RUnit++instance ReasonType Text where+ toReasonType _ = ReasonPrimitive RString++instance ReasonType Day where+ toReasonType _ = ReasonPrimitive RTimePosix++instance ReasonType UTCTime where+ toReasonType _ = ReasonPrimitive RTimePosix++instance ReasonType Float where+ toReasonType _ = ReasonPrimitive RFloat++instance ReasonType Double where+ toReasonType _ = ReasonPrimitive RFloat++instance ReasonType Int8 where+ toReasonType _ = ReasonPrimitive RInt++instance ReasonType Int16 where+ toReasonType _ = ReasonPrimitive RInt++instance ReasonType Int32 where+ toReasonType _ = ReasonPrimitive RInt++instance ReasonType Int64 where+ toReasonType _ = ReasonPrimitive RInt64++instance (ReasonType a, ReasonType b) =>+ ReasonType (a, b) where+ toReasonType _ =+ ReasonPrimitive $+ RTuple2 (toReasonType (Proxy :: Proxy a)) (toReasonType (Proxy :: Proxy b))++instance (ReasonType a, ReasonType b, ReasonType c) =>+ ReasonType (a, b, c) where+ toReasonType _ =+ ReasonPrimitive $+ RTuple3 (toReasonType (Proxy :: Proxy a)) (toReasonType (Proxy :: Proxy b)) (toReasonType (Proxy :: Proxy c))++instance (ReasonType a) =>+ ReasonType (Proxy a) where+ toReasonType _ = toReasonType (undefined :: a)++instance (HasReasonComparable k, ReasonType v) =>+ ReasonType (Map k v) where+ toReasonType _ =+ ReasonPrimitive $+ RMap (toReasonComparable (undefined :: k)) (toReasonType (Proxy :: Proxy v))++instance (ReasonType v) =>+ ReasonType (IntMap v) where+ toReasonType _ = ReasonPrimitive $ RMap RInt (toReasonType (Proxy :: Proxy v))++class HasReasonComparable a where+ toReasonComparable :: a -> ReasonPrimitive++instance HasReasonComparable String where+ toReasonComparable _ = RString++instance HasReasonComparable Text where+ toReasonComparable _ = RString++instance ReasonType Int where+ toReasonType _ = ReasonPrimitive RInt++instance ReasonType Char where+ toReasonType _ = ReasonPrimitive RChar++instance ReasonType Bool where+ toReasonType _ = ReasonPrimitive RBool++-- | Whether a set of constructors is an enumeration, i.e. whether they lack+-- values. data A = A | B | C would be simple data A = A Int | B | C would not+-- be simple.+isEnumeration :: ReasonConstructor -> Bool+isEnumeration (NamedConstructor _ ReasonEmpty) = True+isEnumeration (MultipleConstructors cs) = all isEnumeration cs+isEnumeration _ = False++primitiveName :: ReasonPrimitive -> Text+primitiveName k = pack (show (abs (hash (show k))))
+ test/CommentDecoder.re view
@@ -0,0 +1,20 @@+open CommentType;++let rec decodeComment = json =>+ {+ postId : json |> Json.Decode.field ("postId"+ ,Json.Decode.int),+ text : json |> Json.Decode.field ("text"+ ,Json.Decode.string),+ mainCategories : json |> Json.Decode.field ("mainCategories"+ ,Json.Decode.tuple2(Json.Decode.string+ ,Json.Decode.string)),+ published : json |> Json.Decode.field ("published"+ ,Json.Decode.bool),+ created : json |> Json.Decode.field ("created"+ ,Json.Decode.date),+ tags : json |> Json.Decode.field ("tags"+ ,Json.Decode.map(l => List.fold_left ((m,(k,v)) => Map_651798451719185100.add(k,v,m)+ ,Map_651798451719185100.empty+ ,l)+ ,Json.Decode.list(Json.Decode.tuple2(Json.Decode.string,Json.Decode.int)))),}
+ test/CommentDecoderWithOptions.re view
@@ -0,0 +1,20 @@+open CommentTypeWithOptions;++let rec decodeComment = json =>+ {+ commentPostId : json |> Json.Decode.field ("commentPostId"+ ,Json.Decode.int),+ commentText : json |> Json.Decode.field ("commentText"+ ,Json.Decode.string),+ commentMainCategories : json |> Json.Decode.field ("commentMainCategories"+ ,Json.Decode.tuple2(Json.Decode.string+ ,Json.Decode.string)),+ commentPublished : json |> Json.Decode.field ("commentPublished"+ ,Json.Decode.bool),+ commentCreated : json |> Json.Decode.field ("commentCreated"+ ,Json.Decode.date),+ commentTags : json |> Json.Decode.field ("commentTags"+ ,Json.Decode.map(l => List.fold_left ((m,(k,v)) => Map_651798451719185100.add(k,v,m)+ ,Map_651798451719185100.empty+ ,l)+ ,Json.Decode.list(Json.Decode.tuple2(Json.Decode.string,Json.Decode.int)))),}
+ test/CommentEncoder.re view
@@ -0,0 +1,13 @@+open CommentType;++let rec encodeComment = (x : comment) =>+ Json.Encode.object_+ ([ ( "postId", Json.Encode.int(x.postId) )+ , ( "text", Json.Encode.string(x.text) )+ , ( "mainCategories", Json.Encode.tuple2(Json.Encode.string+ ,Json.Encode.string)(x.mainCategories) )+ , ( "published", Json.Encode.bool(x.published) )+ , ( "created", Json.Encode.date(x.created) )+ , ( "tags", ((x) => Json.Encode.list(Json.Encode.tuple2(Json.Encode.string+ ,Json.Encode.int))(Map_651798451719185100.bindings(x)))(x.tags) )+ ])
+ test/CommentEncoderWithOptions.re view
@@ -0,0 +1,13 @@+open CommentTypeWithOptions;++let rec encodeComment = (x : comment) =>+ Json.Encode.object_+ ([ ( "commentPostId", Json.Encode.int(x.commentPostId) )+ , ( "commentText", Json.Encode.string(x.commentText) )+ , ( "commentMainCategories", Json.Encode.tuple2(Json.Encode.string+ ,Json.Encode.string)(x.commentMainCategories) )+ , ( "commentPublished", Json.Encode.bool(x.commentPublished) )+ , ( "commentCreated", Json.Encode.date(x.commentCreated) )+ , ( "commentTags", ((x) => Json.Encode.list(Json.Encode.tuple2(Json.Encode.string+ ,Json.Encode.int))(Map_651798451719185100.bindings(x)))(x.commentTags) )+ ])
+ test/CommentType.re view
@@ -0,0 +1,10 @@+module Map_651798451719185100 = Map.Make({ type t = string; let compare = compare });++type comment =+ { postId : int+ , text : string+ , mainCategories : (string, string)+ , published : bool+ , created : Js.Date.t+ , tags : Map_651798451719185100.t (int)+ }
+ test/CommentTypeWithOptions.re view
@@ -0,0 +1,10 @@+module Map_651798451719185100 = Map.Make({ type t = string; let compare = compare });++type comment =+ { commentPostId : int+ , commentText : string+ , commentMainCategories : (string, string)+ , commentPublished : bool+ , commentCreated : Js.Date.t+ , commentTags : Map_651798451719185100.t (int)+ }
+ test/ExportSpec.hs view
@@ -0,0 +1,554 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++module ExportSpec where++import qualified Data.Algorithm.Diff as Diff+import qualified Data.Algorithm.DiffOutput as DiffOutput+import Data.Char+import Data.Int+import Data.IntMap+import Data.Map+import Data.Proxy+import Data.Text hiding (head, lines, unlines)+import Data.Time+import Reason+import GHC.Generics+import Test.HUnit (Assertion, assertBool)+import Test.Hspec hiding (Spec)+import Test.Hspec as Hspec+import Text.Printf++-- Debugging hint:+-- ghci> import GHC.Generics+-- ghci> :kind! Rep Post+-- ...+data Post = Post+ { id :: Int+ , name :: String+ , age :: Maybe Double+ , comments :: [Comment]+ , promoted :: Maybe Comment+ , author :: Maybe String+ } deriving (Generic, ReasonType)++data Comment = Comment+ { postId :: Int+ , text :: Text+ , mainCategories :: (String, String)+ , published :: Bool+ , created :: UTCTime+ , tags :: Map String Int+ } deriving (Generic, ReasonType)++data Position+ = Beginning+ | Middle+ | End+ deriving (Generic, ReasonType)++data Timing+ = Start+ | Continue Double+ | Stop+ deriving (Generic, ReasonType)++data Monstrosity+ = NotSpecial+ | OkayIGuess Monstrosity+ | Ridiculous Int String [Monstrosity]+ deriving (Generic, ReasonType)++newtype Useless =+ Useless ()+ deriving (Generic, ReasonType)++data Unit = Unit+ deriving (Generic, ReasonType)++newtype Wrapper = Wrapper Int+ deriving (Generic, ReasonType)++newtype FavoritePlaces = FavoritePlaces+ { positionsByUser :: Map String [Position]+ } deriving (Generic, ReasonType)++-- | We don't actually use this type, we just need to see that it compiles.+data LotsOfInts = LotsOfInts+ { intA :: Int8+ , intB :: Int16+ , intC :: Int32+ , intD :: Int64+ } deriving (Generic, ReasonType)+++data Shadowing = Shadowing+ { prop :: ( (Int, Int), ( String, String ) )+ } deriving (Generic, ReasonType)+++spec :: Hspec.Spec+spec = do+ toReasonTypeSpec+ toReasonDecoderSpec+ toReasonEncoderSpec+ moduleSpecsSpec++toReasonTypeSpec :: Hspec.Spec+toReasonTypeSpec =+ describe "Convert to Reason types." $ do+ it "toReasonTypeSource Post" $+ shouldMatchTypeSource+ (unlines+ ["open CommentType"+ , ""+ ,"%s"])+ defaultOptions+ (Proxy :: Proxy Post)+ "test/PostType.re"+ it "toReasonTypeSource Comment" $+ shouldMatchTypeSource+ (unlines+ [ "module Map_651798451719185100 = Map.Make({ type t = string; let compare = compare });"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Comment)+ "test/CommentType.re"+ it "toReasonTypeSource Position" $+ shouldMatchTypeSource+ (unlines ["%s"])+ defaultOptions+ (Proxy :: Proxy Position)+ "test/PositionType.re"+ it "toReasonTypeSource Timing" $+ shouldMatchTypeSource+ (unlines ["%s"])+ defaultOptions+ (Proxy :: Proxy Timing)+ "test/TimingType.re"+ it "toReasonTypeSource Monstrosity" $+ shouldMatchTypeSource+ (unlines ["%s"])+ defaultOptions+ (Proxy :: Proxy Monstrosity)+ "test/MonstrosityType.re"+ it "toReasonTypeSource Useless" $+ shouldMatchTypeSource+ (unlines ["%s"])+ defaultOptions+ (Proxy :: Proxy Useless)+ "test/UselessType.re"+ it "toReasonTypeSource Unit" $+ shouldMatchTypeSource+ (unlines ["%s"])+ defaultOptions+ (Proxy :: Proxy Unit)+ "test/UnitType.re"+ it "toReasonTypeSource Wrapper" $+ shouldMatchTypeSource+ (unlines ["%s"])+ defaultOptions+ (Proxy :: Proxy Wrapper)+ "test/WrapperType.re"+ it "toReasonTypeSource FavoritePlaces" $+ shouldMatchTypeSource+ (unlines+ [ "open PositionType;"+ , "module Map_651798451719185100 = Map.Make({ type t = string; let compare = compare });"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy FavoritePlaces)+ "test/FavoritePlacesType.re"+ it "toReasonTypeSourceWithOptions Post" $+ shouldMatchTypeSource+ (unlines+ [ "open CommentType;"+ , ""+ , "%s"+ ])+ (defaultOptions {fieldLabelModifier = withPrefix "post"})+ (Proxy :: Proxy Post)+ "test/PostTypeWithOptions.re"+ it "toReasonTypeSourceWithOptions Comment" $+ shouldMatchTypeSource+ (unlines+ [ "module Map_651798451719185100 = Map.Make({ type t = string; let compare = compare });"+ , ""+ , "%s"+ ])+ (defaultOptions {fieldLabelModifier = withPrefix "comment"})+ (Proxy :: Proxy Comment)+ "test/CommentTypeWithOptions.re"+ it "toReasonTypeSource Shadowing" $+ shouldMatchTypeSource+ (unlines+ [ "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Shadowing)+ "test/ShadowingType.re"+ describe "Convert to Reason type references." $ do+ it "toReasonTypeRef Post" $+ toReasonTypeRef (Proxy :: Proxy Post) `shouldBe` "post"+ it "toReasonTypeRef [Comment]" $+ toReasonTypeRef (Proxy :: Proxy [Comment]) `shouldBe` "list (comment)"+ it "toReasonTypeRef (comment, String)" $+ toReasonTypeRef (Proxy :: Proxy (Comment, String)) `shouldBe`+ "(comment, string)"+ it "toReasonTypeRef String" $+ toReasonTypeRef (Proxy :: Proxy String) `shouldBe` "string"+ it "toReasonTypeRef (Maybe String)" $+ toReasonTypeRef (Proxy :: Proxy (Maybe String)) `shouldBe` "option (string)"+ it "toReasonTypeRef [Maybe String]" $+ toReasonTypeRef (Proxy :: Proxy [Maybe String]) `shouldBe`+ "list (option (string))"+ it "toReasonTypeRef (Map String (Maybe String))" $+ toReasonTypeRef (Proxy :: Proxy (Map String (Maybe String))) `shouldBe`+ "Map_651798451719185100.t (option (string))"+ it "toReasonTypeRef (IntMap (Maybe String))" $+ toReasonTypeRef (Proxy :: Proxy (IntMap (Maybe String))) `shouldBe`+ "Map_4250183808575061913.t (option (string))"++toReasonDecoderSpec :: Hspec.Spec+toReasonDecoderSpec =+ describe "Convert to Reason decoders." $ do+ it "toReasonDecoderSource Comment" $+ shouldMatchDecoderSource+ (unlines+ [ "open CommentType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Comment)+ "test/CommentDecoder.re"+ it "toReasonDecoderSource Post" $+ shouldMatchDecoderSource+ (unlines+ [ "open PostType;"+ , "open CommentDecoder;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Post)+ "test/PostDecoder.re"+ it "toReasonDecoderSourceWithOptions Post" $+ shouldMatchDecoderSource+ (unlines+ [ "open PostTypeWithOptions;"+ , "open CommentDecoder;"+ , ""+ , "%s"+ ])+ (defaultOptions {fieldLabelModifier = withPrefix "post"})+ (Proxy :: Proxy Post)+ "test/PostDecoderWithOptions.re"+ it "toReasonDecoderSource Position" $+ shouldMatchDecoderSource+ (unlines+ [ "open PositionType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Position)+ "test/PositionDecoder.re"+ it "toReasonDecoderSource Timing" $+ shouldMatchDecoderSource+ (unlines+ [ "open TimingType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Timing)+ "test/TimingDecoder.re"+ it "toReasonDecoderSource Monstrosity" $+ shouldMatchDecoderSource+ (unlines+ [ "open MonstrosityType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Monstrosity)+ "test/MonstrosityDecoder.re"+ it "toReasonDecoderSourceWithOptions Comment" $+ shouldMatchDecoderSource+ (unlines+ [ "open CommentTypeWithOptions;"+ , ""+ , "%s"+ ])+ (defaultOptions {fieldLabelModifier = withPrefix "comment"})+ (Proxy :: Proxy Comment)+ "test/CommentDecoderWithOptions.re"+ it "toReasonDecoderSource Useless" $+ shouldMatchDecoderSource+ (unlines+ [ "open UselessType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Useless)+ "test/UselessDecoder.re"+ it "toReasonDecoderSource Unit" $+ shouldMatchDecoderSource+ (unlines+ [ "open UnitType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Unit)+ "test/UnitDecoder.re"+ it "toReasonDecoderSource Wrapper" $+ shouldMatchDecoderSource+ (unlines+ [ "open WrapperType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Wrapper)+ "test/WrapperDecoder.re"+ it "toReasonDecoderSource Shadowing" $+ shouldMatchDecoderSource+ (unlines+ [ "open ShadowingType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Shadowing)+ "test/ShadowingDecoder.re"+ describe "Convert to Reason decoder references." $ do+ it "toReasonDecoderRef Post" $+ toReasonDecoderRef (Proxy :: Proxy Post) `shouldBe` "decodePost"+ it "toReasonDecoderRef Position" $+ toReasonDecoderRef (Proxy :: Proxy Position) `shouldBe` "decodePosition"+ it "toReasonDecoderRef Timing" $+ toReasonDecoderRef (Proxy :: Proxy Timing) `shouldBe` "decodeTiming"+ it "toReasonDecoderRef Monstrosity" $+ toReasonDecoderRef (Proxy :: Proxy Monstrosity) `shouldBe` "decodeMonstrosity"+ it "toReasonDecoderRef [Comment]" $+ toReasonDecoderRef (Proxy :: Proxy [Comment]) `shouldBe`+ "Json.Decode.list(decodeComment)"+ it "toReasonDecoderRef String" $+ toReasonDecoderRef (Proxy :: Proxy String) `shouldBe` "Json.Decode.string"+ it "toReasonDecoderRef (Maybe String)" $+ toReasonDecoderRef (Proxy :: Proxy (Maybe String)) `shouldBe`+ "Json.Decode.optional(Json.Decode.string)"+ it "toReasonDecoderRef [Maybe String]" $+ toReasonDecoderRef (Proxy :: Proxy [Maybe String]) `shouldBe`+ "Json.Decode.list(Json.Decode.optional(Json.Decode.string))"+ it "toReasonDecoderRef (Map String (Maybe String))" $+ toReasonDecoderRef (Proxy :: Proxy (Map String (Maybe String))) `shouldBe`+ "Json.Decode.map(l => List.fold_left ((m,(k,v)) => Map_651798451719185100.add(k,v,m)\n ,Map_651798451719185100.empty\n ,l)\n ,Json.Decode.list(Json.Decode.tuple2(Json.Decode.string,Json.Decode.optional(Json.Decode.string))))"+ it "toReasonDecoderRef (IntMap (Maybe String))" $+ toReasonDecoderRef (Proxy :: Proxy (IntMap (Maybe String))) `shouldBe`+ "Json.Decode.map(l => List.fold_left ((m,(k,v)) => Map_4250183808575061913.add(k,v,m)\n ,Map_4250183808575061913.empty\n ,l)\n ,Json.Decode.list(Json.Decode.tuple2(Json.Decode.int,Json.Decode.optional(Json.Decode.string))))"++toReasonEncoderSpec :: Hspec.Spec+toReasonEncoderSpec =+ describe "Convert to Reason encoders." $ do+ it "toReasonEncoderSource Comment" $+ shouldMatchEncoderSource+ (unlines+ [ "open CommentType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Comment)+ "test/CommentEncoder.re"+ it "toReasonEncoderSource Post" $+ shouldMatchEncoderSource+ (unlines+ [ "open PostType;"+ , "open CommentEncoder;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Post)+ "test/PostEncoder.re"+ it "toReasonEncoderSourceWithOptions Comment" $+ shouldMatchEncoderSource+ (unlines+ [ "open CommentTypeWithOptions;"+ , ""+ , "%s"+ ])+ (defaultOptions {fieldLabelModifier = withPrefix "comment"})+ (Proxy :: Proxy Comment)+ "test/CommentEncoderWithOptions.re"+ it "toReasonEncoderSourceWithOptions Post" $+ shouldMatchEncoderSource+ (unlines+ [ "open PostTypeWithOptions;"+ , "open CommentEncoder;"+ , ""+ , "%s"+ ])+ (defaultOptions {fieldLabelModifier = withPrefix "post"})+ (Proxy :: Proxy Post)+ "test/PostEncoderWithOptions.re"+ it "toReasonEncoderSource Position" $+ shouldMatchEncoderSource+ (unlines+ [ "open PositionType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Position)+ "test/PositionEncoder.re"+ it "toReasonEncoderSource Position" $+ shouldMatchEncoderSource+ (unlines+ [ "open ShadowingType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Shadowing)+ "test/ShadowingEncoder.re"+ it "toReasonEncoderSourceWithOptions Timing" $+ shouldMatchEncoderSource+ (unlines+ [ "open TimingType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Timing)+ "test/TimingEncoder.re"+ it "toReasonEncoderSourceWithOptions Monstrosity" $+ shouldMatchEncoderSource+ (unlines+ [ "open MonstrosityType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Monstrosity)+ "test/MonstrosityEncoder.re"+ it "toReasonEncoderSourceWithOptions Useless" $+ shouldMatchEncoderSource+ (unlines+ [ "open UselessType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Useless)+ "test/UselessEncoder.re"+ it "toReasonEncoderSourceWithOptions Unit" $+ shouldMatchEncoderSource+ (unlines+ [ "open UnitType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Unit)+ "test/UnitEncoder.re"+ it "toReasonEncoderSourceWithOptions Wrapper" $+ shouldMatchEncoderSource+ (unlines+ [ "open WrapperType;"+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Wrapper)+ "test/WrapperEncoder.re"+ describe "Convert to Reason encoder references." $ do+ it "toReasonEncoderRef Post" $+ toReasonEncoderRef (Proxy :: Proxy Post) `shouldBe` "encodePost"+ it "toReasonEncoderRef [Comment]" $+ toReasonEncoderRef (Proxy :: Proxy [Comment]) `shouldBe`+ "(Json.Encode.list(encodeComment))"+ it "toReasonEncoderRef Position" $+ toReasonEncoderRef (Proxy :: Proxy Position) `shouldBe` "encodePosition"+ it "toReasonEncoderRef Timing" $+ toReasonEncoderRef (Proxy :: Proxy Timing) `shouldBe` "encodeTiming"+ it "toReasonEncoderRef Monstrosity" $+ toReasonEncoderRef (Proxy :: Proxy Monstrosity) `shouldBe` "encodeMonstrosity"+ it "toReasonEncoderRef String" $+ toReasonEncoderRef (Proxy :: Proxy String) `shouldBe` "Json.Encode.string"+ it "toReasonEncoderRef (Maybe String)" $+ toReasonEncoderRef (Proxy :: Proxy (Maybe String)) `shouldBe`+ "(Json.Encode.nullable(Json.Encode.string))"+ it "toReasonEncoderRef [Maybe String]" $+ toReasonEncoderRef (Proxy :: Proxy [Maybe String]) `shouldBe`+ "(Json.Encode.list((Json.Encode.nullable(Json.Encode.string))))"+ it "toReasonEncoderRef (Map String (Maybe String))" $+ toReasonEncoderRef (Proxy :: Proxy (Map String (Maybe String))) `shouldBe`+ "((x) => Json.Encode.list(Json.Encode.tuple2(Json.Encode.string\n ,(Json.Encode.nullable(Json.Encode.string))))(Map_651798451719185100.bindings(x)))"+ it "toReasonEncoderRef (IntMap (Maybe String))" $+ toReasonEncoderRef (Proxy :: Proxy (IntMap (Maybe String))) `shouldBe`+ "((x) => Json.Encode.list(Json.Encode.tuple2(Json.Encode.int\n ,(Json.Encode.nullable(Json.Encode.string))))(Map_4250183808575061913.bindings(x)))"++moduleSpecsSpec :: Hspec.Spec+moduleSpecsSpec =+ describe "Generating a module Spec" $ do+ let mySpec =+ moduleSpec ["My", "Module"] $ do+ renderType (Proxy :: Proxy Post)+ renderDecoder (Proxy :: Proxy Post)+ renderType (Proxy :: Proxy Comment)+ it "sets the module namespace" $+ namespace mySpec `shouldBe` ["My", "Module"]+ it "inserts the correct imports" $+ head (declarations mySpec) `shouldBe`+ intercalate+ "\n"+ [ "import module Map_651798451719185100 = Map.Make({ type t = string; let compare = compare });" ]++shouldMatchTypeSource+ :: ReasonType a+ => String -> Options -> a -> FilePath -> IO ()+shouldMatchTypeSource wrapping options x =+ shouldMatchFile . printf wrapping $ toReasonTypeSourceWith options x++shouldMatchDecoderSource+ :: ReasonType a+ => String -> Options -> a -> FilePath -> IO ()+shouldMatchDecoderSource wrapping options x =+ shouldMatchFile . printf wrapping $ toReasonDecoderSourceWith options x++shouldMatchEncoderSource+ :: ReasonType a+ => String -> Options -> a -> FilePath -> IO ()+shouldMatchEncoderSource wrapping options x =+ shouldMatchFile . printf wrapping $ toReasonEncoderSourceWith options x++shouldMatchFile :: String -> FilePath -> IO ()+shouldMatchFile actual fileExpected = do+ source <- readFile fileExpected+ actual `shouldBeDiff` (fileExpected, source)++shouldBeDiff :: String -> (String, String) -> Assertion+shouldBeDiff a (fpath, b) =+ assertBool+ ("< generated\n" <> "> " <> fpath <> "\n" <>+ DiffOutput.ppDiff (Diff.getGroupedDiff (lines a) (lines b)))+ (a == b)++initCap :: Text -> Text+initCap t =+ case uncons t of+ Nothing -> t+ Just (c, cs) -> cons (Data.Char.toUpper c) cs++withPrefix :: Text -> Text -> Text+withPrefix prefix s = prefix <> initCap s
+ test/FavoritePlacesType.re view
@@ -0,0 +1,6 @@+open PositionType;+module Map_651798451719185100 = Map.Make({ type t = string; let compare = compare });++type favoritePlaces =+ { positionsByUser : Map_651798451719185100.t (list (position))+ }
+ test/MonstrosityDecoder.re view
@@ -0,0 +1,18 @@+open MonstrosityType;++let rec decodeMonstrosity = json =>+ + json |> (Json.Decode.field("type", 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)),)+ | _ => failwith("unknown constructor")}))
+ test/MonstrosityEncoder.re view
@@ -0,0 +1,18 @@+open MonstrosityType;++let rec encodeMonstrosity = (x : monstrosity) =>+ switch(x) {+ | NotSpecial =>+ Json.Encode.object_+ ([( "type", Json.Encode.string("NotSpecial") ),])+ | OkayIGuess(arg0) =>+ Json.Encode.object_+ ([( "type", Json.Encode.string("OkayIGuess") ),+ ( "arg0", encodeMonstrosity(arg0) ),])++ | Ridiculous(arg0,arg1,arg2) =>+ Json.Encode.object_+ ([( "type", Json.Encode.string("Ridiculous") ),+ ( "arg0", Json.Encode.int(arg0) ),+ ( "arg1", Json.Encode.string(arg1) ),+ ( "arg2", (Json.Encode.list(encodeMonstrosity))(arg2) ),])}
+ test/MonstrosityType.re view
@@ -0,0 +1,4 @@+type monstrosity =+ | NotSpecial+ | OkayIGuess(monstrosity)+ | Ridiculous(int, string, (list (monstrosity)))
+ test/PositionDecoder.re view
@@ -0,0 +1,12 @@+open PositionType;++let rec decodePosition = json =>+ + json |> (Json.Decode.field("type", Json.Decode.string)+ |> Json.Decode.andThen+ ((x) => switch(x)+ {+ | "Beginning" => json => Beginning+ | "Middle" => json => Middle+ | "End" => json => End+ | _ => failwith("unknown constructor")}))
+ test/PositionEncoder.re view
@@ -0,0 +1,7 @@+open PositionType;++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") )])}
+ test/PositionType.re view
@@ -0,0 +1,4 @@+type position =+ | Beginning+ | Middle+ | End
+ test/PostDecoder.re view
@@ -0,0 +1,17 @@+open PostType;+open CommentDecoder;++let rec decodePost = json =>+ {+ id : json |> Json.Decode.field ("id"+ ,Json.Decode.int),+ name : json |> Json.Decode.field ("name"+ ,Json.Decode.string),+ age : json |> Json.Decode.field ("age"+ ,Json.Decode.optional(Json.Decode.float)),+ comments : json |> Json.Decode.field ("comments"+ ,Json.Decode.list(decodeComment)),+ promoted : json |> Json.Decode.field ("promoted"+ ,Json.Decode.optional(decodeComment)),+ author : json |> Json.Decode.field ("author"+ ,Json.Decode.optional(Json.Decode.string)),}
+ test/PostDecoderWithOptions.re view
@@ -0,0 +1,17 @@+open PostTypeWithOptions;+open CommentDecoder;++let rec decodePost = json =>+ {+ postId : json |> Json.Decode.field ("postId"+ ,Json.Decode.int),+ postName : json |> Json.Decode.field ("postName"+ ,Json.Decode.string),+ postAge : json |> Json.Decode.field ("postAge"+ ,Json.Decode.optional(Json.Decode.float)),+ postComments : json |> Json.Decode.field ("postComments"+ ,Json.Decode.list(decodeComment)),+ postPromoted : json |> Json.Decode.field ("postPromoted"+ ,Json.Decode.optional(decodeComment)),+ postAuthor : json |> Json.Decode.field ("postAuthor"+ ,Json.Decode.optional(Json.Decode.string)),}
+ test/PostEncoder.re view
@@ -0,0 +1,12 @@+open PostType;+open CommentEncoder;++let rec encodePost = (x : post) =>+ Json.Encode.object_+ ([ ( "id", Json.Encode.int(x.id) )+ , ( "name", Json.Encode.string(x.name) )+ , ( "age", (Json.Encode.nullable(Json.Encode.float))(x.age) )+ , ( "comments", (Json.Encode.list(encodeComment))(x.comments) )+ , ( "promoted", (Json.Encode.nullable(encodeComment))(x.promoted) )+ , ( "author", (Json.Encode.nullable(Json.Encode.string))(x.author) )+ ])
+ test/PostEncoderWithOptions.re view
@@ -0,0 +1,12 @@+open PostTypeWithOptions;+open CommentEncoder;++let rec encodePost = (x : post) =>+ Json.Encode.object_+ ([ ( "postId", Json.Encode.int(x.postId) )+ , ( "postName", Json.Encode.string(x.postName) )+ , ( "postAge", (Json.Encode.nullable(Json.Encode.float))(x.postAge) )+ , ( "postComments", (Json.Encode.list(encodeComment))(x.postComments) )+ , ( "postPromoted", (Json.Encode.nullable(encodeComment))(x.postPromoted) )+ , ( "postAuthor", (Json.Encode.nullable(Json.Encode.string))(x.postAuthor) )+ ])
+ test/PostType.re view
@@ -0,0 +1,10 @@+open CommentType++type post =+ { id : int+ , name : string+ , age : option (float)+ , comments : list (comment)+ , promoted : option (comment)+ , author : option (string)+ }
+ test/PostTypeWithOptions.re view
@@ -0,0 +1,10 @@+open CommentType;++type post =+ { postId : int+ , postName : string+ , postAge : option (float)+ , postComments : list (comment)+ , postPromoted : option (comment)+ , postAuthor : option (string)+ }
+ test/ShadowingDecoder.re view
@@ -0,0 +1,9 @@+open ShadowingType;++let rec decodeShadowing = json =>+ {+ prop : json |> Json.Decode.field ("prop"+ ,Json.Decode.tuple2(Json.Decode.tuple2(Json.Decode.int+ ,Json.Decode.int)+ ,Json.Decode.tuple2(Json.Decode.string+ ,Json.Decode.string))),}
+ test/ShadowingEncoder.re view
@@ -0,0 +1,9 @@+open ShadowingType;++let rec encodeShadowing = (x : shadowing) =>+ Json.Encode.object_+ ([ ( "prop", Json.Encode.tuple2(Json.Encode.tuple2(Json.Encode.int+ ,Json.Encode.int)+ ,Json.Encode.tuple2(Json.Encode.string+ ,Json.Encode.string))(x.prop) )+ ])
+ test/ShadowingType.re view
@@ -0,0 +1,3 @@+type shadowing =+ { prop : ((int, int), (string, string))+ }
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/TimingDecoder.re view
@@ -0,0 +1,13 @@+open TimingType;++let rec decodeTiming = json =>+ + json |> (Json.Decode.field("type", 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+ | _ => failwith("unknown constructor")}))
+ test/TimingEncoder.re view
@@ -0,0 +1,15 @@+open TimingType;++let rec encodeTiming = (x : timing) =>+ switch(x) {+ | Start =>+ Json.Encode.object_+ ([( "type", Json.Encode.string("Start") ),])+ | Continue(arg0) =>+ Json.Encode.object_+ ([( "type", Json.Encode.string("Continue") ),+ ( "arg0", Json.Encode.float(arg0) ),])++ | Stop =>+ Json.Encode.object_+ ([( "type", Json.Encode.string("Stop") ),])}
+ test/TimingType.re view
@@ -0,0 +1,4 @@+type timing =+ | Start+ | Continue(float)+ | Stop
+ test/UnitDecoder.re view
@@ -0,0 +1,4 @@+open UnitType;++let rec decodeUnit = json =>+ json |> Json.Decode.nullAs(Unit)
+ test/UnitEncoder.re view
@@ -0,0 +1,4 @@+open UnitType;++let rec encodeUnit = (x : unit) =>+ Json.Encode.null
+ test/UnitType.re view
@@ -0,0 +1,2 @@+type unit =+ | Unit
+ test/UselessDecoder.re view
@@ -0,0 +1,4 @@+open UselessType;++let rec decodeUseless = json =>+ json |> Json.Decode.nullAs(Useless)
+ test/UselessEncoder.re view
@@ -0,0 +1,4 @@+open UselessType;++let rec encodeUseless = (x : useless) =>+ Json.Encode.null
+ test/UselessType.re view
@@ -0,0 +1,2 @@+type useless =+ | Useless
+ test/WrapperDecoder.re view
@@ -0,0 +1,5 @@+open WrapperType;++let rec decodeWrapper = json =>+ Wrapper (json |> Json.Decode.field ("arg0"+ ,Json.Decode.int),)
+ test/WrapperEncoder.re view
@@ -0,0 +1,5 @@+open WrapperType;++let rec encodeWrapper = (x : wrapper) =>+ switch(x) {+ | Wrapper(y0) => Json.Encode.int(y0)}
+ test/WrapperType.re view
@@ -0,0 +1,2 @@+type wrapper =+ | Wrapper(int)