Merge pull request #57 from peterbecich/override-foreign-generic-and-…

…aeson

Purescript 0.14 compatibility, bridging of nested types, bridging of `Map`

.github/workflows/haskell.yml

@@ -17,25 +17,19 @@ jobs:
       fail-fast: false
       matrix:
         versions:
-          - ghc: '8.0.2'
-            cabal: '3.2'
-          - ghc: '8.2.2'
-            cabal: '3.2'
-          - ghc: '8.4.4'
-            cabal: '3.2'
           - ghc: '8.6.5'
-            cabal: '3.2'
+            cabal: '3.4'
           - ghc: '8.8.4'
-            cabal: '3.2'
-          - ghc: '8.10.3'
-            cabal: '3.2'
+            cabal: '3.4'
+          - ghc: '8.10.4'
+            cabal: '3.4'
     steps:
     - uses: actions/checkout@v2
 
     # need to install older cabal/ghc versions from ppa repository
 
     - name: Install recent cabal/ghc
-      uses: actions/setup-haskell@v1.1.3
+      uses: haskell/actions/setup@v1
       with:
         ghc-version: ${{ matrix.versions.ghc }}
         cabal-version: ${{ matrix.versions.cabal }}

.github/workflows/purescript.yml

@@ -22,7 +22,7 @@ jobs:
       - name: Set up a PureScript toolchain
         uses: purescript-contrib/setup-purescript@main
         with: # https://github.com/purescript-contrib/setup-purescript#specify-versions
-          purescript: "0.13.8"
+          purescript: "0.14.1"
 
       - name: Cache PureScript dependencies
         uses: actions/cache@v2

README.md

@@ -12,9 +12,13 @@ Data type translation is fully and easily customizable by providing your own `Br
 
 ## JSON encoding / decoding
 
-For compatible JSON representations you should be using [aeson](http://hackage.haskell.org/package/aeson)'s generic encoding/decoding with default options
-and `encodeJson` and `decodeJson` from "Data.Argonaut.Generic.Aeson" in [purescript-argonaut-generic-codecs](https://github.com/eskimor/purescript-argonaut-generic-codecs).
+For compatible JSON representations:
 
+* On Haskell side:
+  * Use [`aeson`](http://hackage.haskell.org/package/aeson)'s generic encoding/decoding with default options
+* On Purescript side:
+  * Use [`purescript-argonaut-aeson-generic`](https://pursuit.purescript.org/packages/purescript-argonaut-aeson-generic). [This branch](https://github.com/coot/purescript-argonaut-aeson-generic/pull/15) is updated for Purescript 0.14.
+  * Or use [`purescript-foreign-generic`](https://pursuit.purescript.org/packages/purescript-foreign-generic).
 
 ## Documentation
 

example/app/GeneratePurescript.hs

@@ -1,10 +1,11 @@
 module Main where
 
-import Control.Lens
-import Data.Text (pack)
-import Language.PureScript.Bridge
-import Language.PureScript.Bridge.CodeGenSwitches
-    (ForeignOptions (ForeignOptions), genForeign, useGenRep)
+import           Control.Lens
+import           Data.Text                                  (pack)
+import           Language.PureScript.Bridge
+import           Language.PureScript.Bridge.CodeGenSwitches (ForeignOptions (ForeignOptions),
+                                                             genForeign,
+                                                             useGenRep)
 
 import qualified MyLib
 import           Types

example/example.cabal

@@ -15,6 +15,7 @@ library
                      , aeson >= 1.5.5.0
                      , aeson-pretty
                      , bytestring
+                     , containers
                      , lens
                      , transformers
                      , servant >=0.18.0

example/packages.dhall

@@ -1,13 +1,5 @@
 let upstream =
-      https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20210118/packages.dhall sha256:a59c5c93a68d5d066f3815a89f398bcf00e130a51cb185b2da29b20e2d8ae115
-
-let overrides =
-      { argonaut-generic = upstream.argonaut-generic ⫽ { version = "v5.0.0" }
-      , argonaut = upstream.argonaut ⫽ { version = "v6.0.0" }
-      , argonaut-codecs = upstream.argonaut-codecs ⫽ { version = "v6.0.2" }
-      , argonaut-traversals =
-          upstream.argonaut-traversals ⫽ { version = "v6.0.0" }
-      }
+      https://github.com/purescript/package-sets/releases/download/psc-0.14.1-20210516/packages.dhall sha256:f5e978371d4cdc4b916add9011021509c8d869f4c3f6d0d2694c0e03a85046c8
 
 let additions =
       { argonaut-aeson-generic =
@@ -21,9 +13,10 @@ let additions =
           , "psci-support"
           , "test-unit"
           ]
-        , repo = "git://github.com/coot/purescript-argonaut-aeson-generic.git"
-        , version = "2201093f39d58befe7e4ae9e2f587e340ee54a28"
+        , repo =
+            "git://github.com/peterbecich/purescript-argonaut-aeson-generic.git"
+        , version = "2c8c5ee2381ddb786af7fb79a73e3b83001d68e8"
         }
       }
 
-in  upstream ⫽ overrides ⫽ additions
+in  upstream ⫽ additions

example/readme.md

@@ -12,7 +12,7 @@ In this directory:
 
 - `cabal run example`
 
-- Open http://localhost:8080/index.html
+- Open [http://localhost:8080/index.html](http://localhost:8080/index.html)
 
 - Open the browser's developer console and look for the message received:
 

example/spago.dhall

@@ -1,7 +1,3 @@
-{-
-Welcome to a Spago project!
-You can edit this file as you like.
--}
 { name = "purescript-bridge-example"
 , dependencies =
   [ "console"
@@ -12,6 +8,15 @@ You can edit this file as you like.
   , "aff"
   , "affjax"
   , "argonaut-aeson-generic"
+  , "ordered-collections"
+  , "argonaut-codecs"
+  , "argonaut-generic"
+  , "either"
+  , "foldable-traversable"
+  , "foreign-object"
+  , "maybe"
+  , "newtype"
+  , "prelude"
   ]
 , packages = ./packages.dhall
 , sources = [ "src/**/*.purs", "test/**/*.purs" ]

example/src/Main.purs

@@ -2,6 +2,7 @@ module Main where
 
 import Prelude
 
+import Data.Argonaut.Decode.Error (JsonDecodeError, printJsonDecodeError)
 import Data.Argonaut.Aeson.Decode.Generic (genericDecodeAeson)
 import Data.Argonaut.Aeson.Encode.Generic (genericEncodeAeson)
 import Data.Argonaut.Aeson.Options (defaultOptions)
@@ -17,8 +18,14 @@ import Effect.Aff (launchAff_)
 import Affjax (get, post_)
 import Affjax.ResponseFormat (json)
 import Affjax.RequestBody as RequestBody
-
 import Types (Foo, fooMessage, fooNumber, fooList)
+import Data.Argonaut.Decode.Error (JsonDecodeError)
+import Data.Argonaut.Decode.Generic (genericDecodeJson)
+import Data.Argonaut.Encode.Generic (genericEncodeJson)
+import Types (Foo, fooMessage, fooNumber, fooList, fooMap)
+import Data.Map as Map
+
+import Foreign.Object as Object
 
 main :: Effect Unit
 main = log "Hello, Purescript!" *> launchAff_ do
@@ -29,23 +36,25 @@ main = log "Hello, Purescript!" *> launchAff_ do
   fooResponse <- get json "/foo"
   for_ fooResponse \fooPayload -> do
     let
-      efoo :: Either String Foo
+      efoo :: Either JsonDecodeError Foo
       efoo = genericDecodeAeson defaultOptions fooPayload.body
     case efoo of
-      Left e -> liftEffect $ log $ "Error decoding Foo: " <> e
+      Left e -> liftEffect $ log $ "Error decoding Foo: " <> printJsonDecodeError e
       Right _ -> pure unit
     for_ efoo \foo -> do
       liftEffect do
         log $ "Foo message: " <> (view fooMessage foo)
           <> "\t Foo number: " <> (show $ view fooNumber foo)
           <> "\t Foo list length: "
           <> (show (length $ view fooList foo :: Int))
+          <> "\t Foo map size: "
+          <> (show (Object.size $ view fooMap foo :: Int))
       let
         -- modify the Foo received and send it back
         foo' = set fooMessage "Hola"
                $ over fooNumber (_+1)
                $ over fooList (\l -> l <> l)
+               $ over fooMap (\o -> Object.insert "abc" 123 o)
                $ foo
         response = Just $ RequestBody.json $ genericEncodeAeson defaultOptions foo'
       post_ "/foo" response
-

example/src/MyLib.hs

@@ -4,30 +4,36 @@
 
 module MyLib (main) where
 
-import Prelude
+import           Prelude
 
-import           Control.Lens (view)
-import           Control.Monad.IO.Class (liftIO)
+import           Control.Lens               (view)
+import           Control.Monad.IO.Class     (liftIO)
 import           Data.Aeson
-import qualified Data.Aeson.Encode.Pretty as AP
+import qualified Data.Aeson.Encode.Pretty   as AP
 import qualified Data.ByteString.Lazy.Char8 as Char8
-import           Data.Text (pack, unpack)
+import qualified Data.Map.Lazy              as Map
+import           Data.Text                  (pack, unpack)
 import           GHC.Generics
 import           GHC.TypeLits
 import           Network.Wai.Handler.Warp
 import           Servant
-import           System.Environment (lookupEnv)
+import           System.Environment         (lookupEnv)
 
-import Types
-    (Foo (Foo), fooMessage, fooNumber, fooList)
+import           Types                      (Baz (Baz), Foo (Foo), fooList,
+                                             fooMap, fooMessage, fooNumber)
 
 type FooServer
   = "foo" :> (Get '[JSON] Foo
               :<|> ReqBody '[JSON] Foo :> Post '[JSON] NoContent
              )
 
 foo :: Foo
-foo = Foo (pack "Hello") 123 [10..20]
+foo = Foo
+  (pack "Hello")
+  123
+  [10..20]
+  (Map.fromList [(pack "foo", 2), (pack "bar", 3), (pack "baz", 3)])
+  (Baz $ pack "hello")
 
 fooServer :: Server FooServer
 fooServer = getFoo :<|> postFoo
@@ -38,6 +44,7 @@ fooServer = getFoo :<|> postFoo
         logMsg = "Foo message: " <> (unpack $ view fooMessage foo)
           <> "\t Foo number: " <> (show (view fooNumber foo))
           <> "\t Foo list length: " <> (show . length $ view fooList foo)
+          <> "\t Foo Map length: " <> (show . length $ view fooMap foo)
       liftIO . putStrLn $ logMsg
       return NoContent
 

example/src/Types.hs

@@ -7,18 +7,30 @@
 
 module Types where
 
-import Control.Lens.TH (makeLenses)
-import Data.Aeson
-import Data.Proxy
-import Data.Text
-import GHC.Generics
-import Language.PureScript.Bridge
-import Language.PureScript.Bridge.PSTypes
+import           Control.Lens.TH                    (makeLenses)
+import           Data.Aeson
+import qualified Data.Map.Lazy                      as Map
+import           Data.Proxy
+import           Data.Text
+import           GHC.Generics
+import           Language.PureScript.Bridge
+import           Language.PureScript.Bridge.PSTypes
+
+data Baz = Baz
+  { _bazMessage :: Text
+  } deriving (Generic, ToJSON, FromJSON)
+
+makeLenses ''Baz
+
+bazProxy :: Proxy Baz
+bazProxy = Proxy
 
 data Foo = Foo
   { _fooMessage :: Text
   , _fooNumber  :: Int
   , _fooList    :: [Int]
+  , _fooMap     :: Map.Map Text Int
+  , _fooBaz     :: Baz
   } deriving (Generic, ToJSON, FromJSON)
 
 makeLenses ''Foo
@@ -31,5 +43,6 @@ myBridge = defaultBridge
 
 myTypes :: [SumType 'Haskell]
 myTypes =
-  [ mkSumType (Proxy :: Proxy Foo)
+  [ mkSumType (Proxy :: Proxy Baz)
+  , mkSumType (Proxy :: Proxy Foo)
   ]

example/src/Types.purs

@@ -1,6 +1,11 @@
 -- File auto generated by purescript-bridge! --
 module Types where
 
+import Data.Argonaut.Aeson.Decode.Generic (genericDecodeAeson)
+import Data.Argonaut.Aeson.Encode.Generic (genericEncodeAeson)
+import Data.Argonaut.Aeson.Options as Argonaut
+import Data.Argonaut.Decode.Class (class DecodeJson, decodeJson)
+import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson)
 import Data.Generic.Rep (class Generic)
 import Data.Lens (Iso', Lens', Prism', lens, prism')
 import Data.Lens.Iso.Newtype (_Newtype)
@@ -10,26 +15,57 @@ import Data.Newtype (class Newtype)
 import Data.Symbol (SProxy(SProxy))
 import Foreign.Class (class Decode, class Encode)
 import Foreign.Generic (defaultOptions, genericDecode, genericEncode)
+import Foreign.Object (Object)
 import Prim (Array, Int, String)
 
 import Prelude
 
+newtype Baz =
+    Baz {
+      _bazMessage :: String
+    }
+
+instance encodeBaz :: Encode Baz where
+  encode = genericEncode $ defaultOptions { unwrapSingleConstructors = false , unwrapSingleArguments = false }
+instance decodeBaz :: Decode Baz where
+  decode = genericDecode $ defaultOptions { unwrapSingleConstructors = false , unwrapSingleArguments = false }
+instance encodeJsonBaz :: EncodeJson Baz where
+  encodeJson = genericEncodeAeson Argonaut.defaultOptions
+instance decodeJsonBaz :: DecodeJson Baz where
+  decodeJson = genericDecodeAeson Argonaut.defaultOptions
+derive instance genericBaz :: Generic Baz _
+derive instance newtypeBaz :: Newtype Baz _
+
+--------------------------------------------------------------------------------
+_Baz :: Iso' Baz { _bazMessage :: String}
+_Baz = _Newtype
+
+bazMessage :: Lens' Baz String
+bazMessage = _Newtype <<< prop (SProxy :: SProxy "_bazMessage")
+
+--------------------------------------------------------------------------------
 newtype Foo =
     Foo {
       _fooMessage :: String
     , _fooNumber :: Int
     , _fooList :: Array Int
+    , _fooMap :: Object Int
+    , _fooBaz :: Baz
     }
 
 instance encodeFoo :: Encode Foo where
   encode = genericEncode $ defaultOptions { unwrapSingleConstructors = false , unwrapSingleArguments = false }
 instance decodeFoo :: Decode Foo where
   decode = genericDecode $ defaultOptions { unwrapSingleConstructors = false , unwrapSingleArguments = false }
+instance encodeJsonFoo :: EncodeJson Foo where
+  encodeJson = genericEncodeAeson Argonaut.defaultOptions
+instance decodeJsonFoo :: DecodeJson Foo where
+  decodeJson = genericDecodeAeson Argonaut.defaultOptions
 derive instance genericFoo :: Generic Foo _
 derive instance newtypeFoo :: Newtype Foo _
 
 --------------------------------------------------------------------------------
-_Foo :: Iso' Foo { _fooMessage :: String, _fooNumber :: Int, _fooList :: Array Int}
+_Foo :: Iso' Foo { _fooMessage :: String, _fooNumber :: Int, _fooList :: Array Int, _fooMap :: Object Int, _fooBaz :: Baz}
 _Foo = _Newtype
 
 fooMessage :: Lens' Foo String
@@ -41,4 +77,10 @@ fooNumber = _Newtype <<< prop (SProxy :: SProxy "_fooNumber")
 fooList :: Lens' Foo (Array Int)
 fooList = _Newtype <<< prop (SProxy :: SProxy "_fooList")
 
+fooMap :: Lens' Foo (Object Int)
+fooMap = _Newtype <<< prop (SProxy :: SProxy "_fooMap")
+
+fooBaz :: Lens' Foo Baz
+fooBaz = _Newtype <<< prop (SProxy :: SProxy "_fooBaz")
+
 --------------------------------------------------------------------------------

src/Language/PureScript/Bridge.hs

@@ -130,6 +130,7 @@ defaultBridge = textBridge
     <|> listBridge
     <|> maybeBridge
     <|> eitherBridge
+    <|> strMapBridge
     <|> boolBridge
     <|> intBridge
     <|> doubleBridge