Skip to content

Commit

Permalink
calendar test example
Browse files Browse the repository at this point in the history
  • Loading branch information
peterbecich committed Mar 31, 2024
1 parent dd3fabf commit 8c372c0
Show file tree
Hide file tree
Showing 8 changed files with 53 additions and 23 deletions.
4 changes: 2 additions & 2 deletions example/app/Main.hs
Original file line number Diff line number Diff line change
@@ -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
Expand Down
3 changes: 2 additions & 1 deletion example/src/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)


Expand Down
1 change: 1 addition & 0 deletions purescript-bridge.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -67,6 +67,7 @@ Test-Suite tests
, purescript-bridge
, QuickCheck
, text
, text-show
, utf8-string
, wl-pprint-text

Expand Down
6 changes: 3 additions & 3 deletions src/Language/PureScript/Bridge/Printer.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Check warning on line 11 in src/Language/PureScript/Bridge/Printer.hs

View workflow job for this annotation

GitHub Actions / linux (9.2.4, 3.6)

The import of ‘Data.Maybe’ is redundant

Check warning on line 11 in src/Language/PureScript/Bridge/Printer.hs

View workflow job for this annotation

GitHub Actions / linux (9.4.6, 3.6)

The import of ‘Data.Maybe’ is redundant
import Debug.Trace

import Control.Arrow ((&&&))
import Control.Lens (to, (%~), (<>~), (^.))
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -51,7 +52,7 @@ data TestSum
| Int Int
| Number Number
| String String
| Array (Array Int)
| Array (List Int)

derive instance Eq TestSum

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -67,7 +68,7 @@ data TestSum
| Int Int
| Number Number
| String String
| Array (Array Int)
| Array (List Int)
| InlineRecord
{ why :: String
, wouldYouDoThis :: Int
Expand Down
40 changes: 25 additions & 15 deletions test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,7 +32,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)

Expand Down Expand Up @@ -85,6 +86,16 @@ 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
-- TODO
txt =
T.unlines []
in doc `shouldRender` txt
it "tests generation of custom typeclasses" $
let sumType =
bridgeSumType
Expand Down Expand Up @@ -232,20 +243,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
Expand Down
16 changes: 16 additions & 0 deletions test/TestData.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
Expand All @@ -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)
Expand All @@ -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
Expand Down Expand Up @@ -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

0 comments on commit 8c372c0

Please sign in to comment.