calendar datatype test

#89 (comment)
eskimor · Mar 31, 2024 · f2e973c · f2e973c
1 parent dd3fabf
commit f2e973c
Show file tree

Hide file tree

Showing 8 changed files with 71 additions and 23 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -3,13 +3,15 @@
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE TypeApplications      #-}
 
 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
@@ -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