diff --git a/example/app/Main.hs b/example/app/Main.hs index 61436093..c538f02f 100644 --- a/example/app/Main.hs +++ b/example/app/Main.hs @@ -1,12 +1,12 @@ module Main where +import ArgonautTypes import Control.Lens import Data.Text (pack) +import JsonHelpersTypes import Language.PureScript.Bridge import qualified MyLib (main) import Types -import ArgonautTypes -import JsonHelpersTypes main :: IO () main = do diff --git a/example/src/Types.hs b/example/src/Types.hs index ddd76f22..6461d251 100644 --- a/example/src/Types.hs +++ b/example/src/Types.hs @@ -49,7 +49,8 @@ makeLenses ''Baz data ID a = ID deriving (Generic, Show) -newtype ID2 a = ID2 {getID :: Int} +newtype ID2 a + = ID2 { getID :: Int } deriving (Generic, Show) diff --git a/purescript-bridge.cabal b/purescript-bridge.cabal index 42ed0ba9..ec1c4e16 100644 --- a/purescript-bridge.cabal +++ b/purescript-bridge.cabal @@ -67,8 +67,10 @@ Test-Suite tests , purescript-bridge , QuickCheck , text + , text-show , utf8-string , wl-pprint-text + , string-qq hs-source-dirs: test default-language: Haskell2010 diff --git a/src/Language/PureScript/Bridge/Printer.hs b/src/Language/PureScript/Bridge/Printer.hs index 0aa7cb55..002316f3 100644 --- a/src/Language/PureScript/Bridge/Printer.hs +++ b/src/Language/PureScript/Bridge/Printer.hs @@ -7,9 +7,9 @@ module Language.PureScript.Bridge.Printer where -import Debug.Trace -import Data.Maybe (listToMaybe) -import Data.Char (isLower) +import Data.Char (isLower) +import Data.Maybe (listToMaybe) +import Debug.Trace import Control.Arrow ((&&&)) import Control.Lens (to, (%~), (<>~), (^.)) diff --git a/test/RoundTripArgonautAesonGeneric/app/src/RoundTripArgonautAesonGeneric/Types.purs b/test/RoundTripArgonautAesonGeneric/app/src/RoundTripArgonautAesonGeneric/Types.purs index 43a2d9a5..8655a59f 100644 --- a/test/RoundTripArgonautAesonGeneric/app/src/RoundTripArgonautAesonGeneric/Types.purs +++ b/test/RoundTripArgonautAesonGeneric/app/src/RoundTripArgonautAesonGeneric/Types.purs @@ -22,6 +22,7 @@ import Data.Lens.Record (prop) import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype) import Data.Show.Generic (genericShow) +import GHC.Types (List) import Type.Proxy (Proxy(Proxy)) newtype TestData = Maybe (Maybe TestSum) @@ -51,7 +52,7 @@ data TestSum | Int Int | Number Number | String String - | Array (Array Int) + | Array (List Int) derive instance Eq TestSum diff --git a/test/RoundTripJsonHelpers/app/src/RoundTripJsonHelpers/Types.purs b/test/RoundTripJsonHelpers/app/src/RoundTripJsonHelpers/Types.purs index a458e8a3..ba8b29b5 100644 --- a/test/RoundTripJsonHelpers/app/src/RoundTripJsonHelpers/Types.purs +++ b/test/RoundTripJsonHelpers/app/src/RoundTripJsonHelpers/Types.purs @@ -32,6 +32,7 @@ import Data.Show.Generic (genericShow) import Data.Tuple (Tuple) import Data.Tuple.Nested ((/\)) import Foreign.Object (Object) +import GHC.Types (List) import Type.Proxy (Proxy(Proxy)) data TestData @@ -67,7 +68,7 @@ data TestSum | Int Int | Number Number | String String - | Array (Array Int) + | Array (List Int) | InlineRecord { why :: String , wouldYouDoThis :: Int diff --git a/test/Spec.hs b/test/Spec.hs index bbd4ba8d..f0da4c7c 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} @@ -10,6 +11,7 @@ module Main where import qualified Data.Map as Map import Data.Monoid ((<>)) +import Data.String.QQ import Data.Text (Text) import qualified Data.Text as T import Data.Word (Word, Word64) @@ -32,7 +34,8 @@ import qualified RoundTripJsonHelpers.Spec (roundtripSpec) import Test.Hspec (Spec, describe, hspec, it) import Test.Hspec.Expectations.Pretty (Expectation, shouldBe) import TestData (Bar, Foo, Func, Simple, SingleProduct, SingleRecord, - SingleValueConstr, SomeNewtype) + SingleValueConstr, SomeNewtype, WeekInMonth, + weekInMonth) import Text.PrettyPrint.Leijen.Text (Doc, cat, linebreak, punctuate, vsep) @@ -85,6 +88,31 @@ customDerived (SumType t cs is) = SumType t cs $ customInstance : is allTests :: Spec allTests = do describe "buildBridge without lens-code-gen" $ do + it "week in month" $ do + let sumType = + bridgeSumType + (buildBridge defaultBridge) + (mkSumType @WeekInMonth) + doc = vsep $ sumTypeToDocs sumType + txt = T.pack [s| +data WeekInMonth + = WeekFirst + | WeekSecond + | WeekThird + | WeekFourth + | WeekLast + +derive instance Generic WeekInMonth _ + +instance Enum WeekInMonth where + succ = genericSucc + pred = genericPred + +instance Bounded WeekInMonth where + bottom = genericBottom + top = genericTop +|] + in doc `shouldRender` txt it "tests generation of custom typeclasses" $ let sumType = bridgeSumType @@ -232,20 +260,19 @@ allTests = do , "derive instance Newtype SingleValueConstr _" ] in doc `shouldRender` txt - it - "tests generation for haskell data type with one constructor, two arguments" - $ let recType' = - bridgeSumType - (buildBridge defaultBridge) - (mkSumType @SingleProduct) - doc = vsep $ sumTypeToDocs recType' - txt = - T.unlines - [ "data SingleProduct = SingleProduct String Int" - , "" - , "derive instance Generic SingleProduct _" - ] - in doc `shouldRender` txt + it "tests generation for haskell data type with one constructor, two arguments" $ + let recType' = + bridgeSumType + (buildBridge defaultBridge) + (mkSumType @SingleProduct) + doc = vsep $ sumTypeToDocs recType' + txt = + T.unlines + [ "data SingleProduct = SingleProduct String Int" + , "" + , "derive instance Generic SingleProduct _" + ] + in doc `shouldRender` txt it "tests generation Eq instances for polymorphic types" $ let recType' = bridgeSumType diff --git a/test/TestData.hs b/test/TestData.hs index 519bbb09..4cd8df93 100644 --- a/test/TestData.hs +++ b/test/TestData.hs @@ -1,6 +1,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} @@ -9,6 +11,7 @@ module TestData where +import qualified Data.Aeson as Aeson import Data.Functor.Classes (Eq1 (liftEq)) import Data.Proxy () import Data.Text (Text) @@ -24,6 +27,8 @@ import Language.PureScript.Bridge (BridgePart, DataConstructor, mkTypeInfo, typeModule, typeName, (<|>), (^==)) import Language.PureScript.Bridge.PSTypes (psString) +import TextShow +import TextShow.Generic (FromGeneric (..)) -- Check that examples compile: textBridge :: BridgePart @@ -113,3 +118,14 @@ t :: TypeInfo 'PureScript cs :: [DataConstructor 'PureScript] psB :: SumType 'PureScript psB@(SumType t cs _) = bridgeSumType (buildBridge defaultBridge) b + +data WeekInMonth = WeekFirst | WeekSecond | WeekThird | WeekFourth | WeekLast + deriving (Eq, Generic, Show) + deriving (TextShow) + via FromGeneric WeekInMonth +instance Aeson.ToJSON WeekInMonth where + toEncoding = Aeson.genericToEncoding Aeson.defaultOptions +instance Aeson.FromJSON WeekInMonth + +weekInMonth :: HaskellType +weekInMonth = mkTypeInfo @WeekInMonth