Merge pull request #30 from GoNZooo/r.add-basic-haskell-tests

fix(hs): fix bug in number literal output

CHANGELOG.md

@@ -1,5 +1,11 @@
 # Changelog
 
+## 2.2.2
+
+### Fixes
+
+- Fixed bug in Haskell number literal output
+
 ## 2.2.1
 
 ### Fixes

package.yaml

@@ -1,5 +1,5 @@
 name:    gotyno-hs
-version: 2.2.1
+version: 2.2.2
 synopsis: A type definition compiler supporting multiple output languages.
 description: Compiles type definitions into F#, TypeScript and Python, with validators, decoders and encoders.
 license: BSD2

src/CodeGeneration/Haskell.hs

@@ -220,7 +220,7 @@ outputEnumeration name values' =
             )
           & Text.intercalate "\n"
       outputLiteral (LiteralString s) = mconcat ["String \"", s, "\""]
-      outputLiteral (LiteralInteger i) = mconcat ["Number $ fromInteger", tshow i]
+      outputLiteral (LiteralInteger i) = mconcat ["Number $ fromInteger ", tshow i]
       outputLiteral (LiteralFloat f) = mconcat ["Number ", tshow f]
       outputLiteral (LiteralBoolean b) = mconcat ["Boolean ", tshow b]
       fromJsonOutput =
@@ -299,17 +299,21 @@ outputGenericStruct name typeVariables fields =
         mconcat
           [ classHeaderOutput "ToJSON",
             "\n",
-            "  toJSON = JSON.genericToJSON\n",
-            "    JSON.defaultOptions {JSON.fieldLabelModifier = drop @[] (length \"_",
+            "  toJSON =\n",
+            "    JSON.genericToJSON\n",
+            "      JSON.defaultOptions\n",
+            "        {JSON.fieldLabelModifier = drop @[] (length \"_",
             nameOf name,
             "\") >>> lowerCaseFirst}"
           ]
       fromJsonOutput =
         mconcat
           [ classHeaderOutput "FromJSON",
             "\n",
-            "  parseJSON = JSON.genericParseJSON\n",
-            "    JSON.defaultOptions {JSON.fieldLabelModifier = drop @[] (length \"_",
+            "  parseJSON =\n",
+            "    JSON.genericParseJSON\n",
+            "      JSON.defaultOptions\n",
+            "        {JSON.fieldLabelModifier = drop @[] (length \"_",
             nameOf name,
             "\") >>> lowerCaseFirst}"
           ]

test/HaskellOutputSpec.hs

@@ -60,12 +60,16 @@ spec = do
                 "  deriving (Eq, Show, Generic)",
                 "",
                 "instance (FromJSON t, FromJSON u) => FromJSON (Holder t u) where",
-                "  parseJSON = JSON.genericParseJSON",
-                "    JSON.defaultOptions {JSON.fieldLabelModifier = drop @[] (length \"_Holder\") >>> lowerCaseFirst}",
+                "  parseJSON =",
+                "    JSON.genericParseJSON",
+                "      JSON.defaultOptions",
+                "        {JSON.fieldLabelModifier = drop @[] (length \"_Holder\") >>> lowerCaseFirst}",
                 "",
                 "instance (ToJSON t, ToJSON u) => ToJSON (Holder t u) where",
-                "  toJSON = JSON.genericToJSON",
-                "    JSON.defaultOptions {JSON.fieldLabelModifier = drop @[] (length \"_Holder\") >>> lowerCaseFirst}",
+                "  toJSON =",
+                "    JSON.genericToJSON",
+                "      JSON.defaultOptions",
+                "        {JSON.fieldLabelModifier = drop @[] (length \"_Holder\") >>> lowerCaseFirst}",
                 "",
                 "makeLenses ''Holder",
                 ""
@@ -360,12 +364,16 @@ spec = do
                 "  deriving (Eq, Show, Generic)",
                 "",
                 "instance (FromJSON t) => FromJSON (Holder t) where",
-                "  parseJSON = JSON.genericParseJSON",
-                "    JSON.defaultOptions {JSON.fieldLabelModifier = drop @[] (length \"_Holder\") >>> lowerCaseFirst}",
+                "  parseJSON =",
+                "    JSON.genericParseJSON",
+                "      JSON.defaultOptions",
+                "        {JSON.fieldLabelModifier = drop @[] (length \"_Holder\") >>> lowerCaseFirst}",
                 "",
                 "instance (ToJSON t) => ToJSON (Holder t) where",
-                "  toJSON = JSON.genericToJSON",
-                "    JSON.defaultOptions {JSON.fieldLabelModifier = drop @[] (length \"_Holder\") >>> lowerCaseFirst}",
+                "  toJSON =",
+                "    JSON.genericToJSON",
+                "      JSON.defaultOptions",
+                "        {JSON.fieldLabelModifier = drop @[] (length \"_Holder\") >>> lowerCaseFirst}",
                 "",
                 "makeLenses ''Holder",
                 "",
@@ -376,12 +384,16 @@ spec = do
                 "  deriving (Eq, Show, Generic)",
                 "",
                 "instance (FromJSON t) => FromJSON (MaybeHolder t) where",
-                "  parseJSON = JSON.genericParseJSON",
-                "    JSON.defaultOptions {JSON.fieldLabelModifier = drop @[] (length \"_MaybeHolder\") >>> lowerCaseFirst}",
+                "  parseJSON =",
+                "    JSON.genericParseJSON",
+                "      JSON.defaultOptions",
+                "        {JSON.fieldLabelModifier = drop @[] (length \"_MaybeHolder\") >>> lowerCaseFirst}",
                 "",
                 "instance (ToJSON t) => ToJSON (MaybeHolder t) where",
-                "  toJSON = JSON.genericToJSON",
-                "    JSON.defaultOptions {JSON.fieldLabelModifier = drop @[] (length \"_MaybeHolder\") >>> lowerCaseFirst}",
+                "  toJSON =",
+                "    JSON.genericToJSON",
+                "      JSON.defaultOptions",
+                "        {JSON.fieldLabelModifier = drop @[] (length \"_MaybeHolder\") >>> lowerCaseFirst}",
                 "",
                 "makeLenses ''MaybeHolder",
                 "",

test/ParsingSpec.hs

@@ -28,7 +28,14 @@ data TypeScriptReferenceOutput = TypeScriptReferenceOutput
   }
 
 data HaskellReferenceOutput = HaskellReferenceOutput
-  { basic :: !Text,
+  { basicStruct :: !Text,
+    basicUnion :: !Text,
+    genericStruct :: !Text,
+    genericUnion :: !Text,
+    basicEnumeration :: !Text,
+    basicImport :: !Text,
+    basicOptional :: !Text,
+    basic :: !Text,
     import' :: !Text,
     hasGeneric :: !Text,
     generics :: !Text,
@@ -110,12 +117,33 @@ typeScriptReferenceOutput = do
 
 haskellReferenceOutput :: IO HaskellReferenceOutput
 haskellReferenceOutput = do
+  basicStruct <- basicStructReferenceOutput "hs"
+  basicUnion <- basicUnionReferenceOutput "hs"
+  genericStruct <- genericStructReferenceOutput "hs"
+  genericUnion <- genericUnionReferenceOutput "hs"
+  basicEnumeration <- basicEnumerationReferenceOutput "hs"
+  basicImport <- basicImportReferenceOutput "hs"
+  basicOptional <- basicOptionalReferenceOutput "hs"
   basic <- basicReferenceOutput "hs"
   import' <- importReferenceOutput "hs"
   hasGeneric <- hasGenericReferenceOutput "hs"
   generics <- genericsReferenceOutput "hs"
   gitHub <- gitHubReferenceOutput "hs"
-  pure HaskellReferenceOutput {basic, import', hasGeneric, generics, gitHub}
+  pure
+    HaskellReferenceOutput
+      { basicStruct,
+        basicUnion,
+        genericStruct,
+        genericUnion,
+        basicEnumeration,
+        basicImport,
+        basicOptional,
+        basic,
+        import',
+        hasGeneric,
+        generics,
+        gitHub
+      }
 
 fSharpReferenceOutput :: IO FSharpReferenceOutput
 fSharpReferenceOutput = do
@@ -261,7 +289,20 @@ spec
       tsGenerics
       tsGitHub
     )
-  (HaskellReferenceOutput hsBasic hsImport hsHasGeneric hsGenerics hsGitHub)
+  ( HaskellReferenceOutput
+      hsBasicStruct
+      hsBasicUnion
+      hsGenericStruct
+      hsGenericUnion
+      hsBasicEnumeration
+      hsBasicImport
+      hsBasicOptional
+      hsBasic
+      hsImport
+      hsHasGeneric
+      hsGenerics
+      hsGitHub
+    )
   (FSharpReferenceOutput fsBasic fsImport fsHasGeneric fsGenerics fsGitHub)
   (PythonReferenceOutput pyPython pyBasic pyGenerics)
   ( KotlinReferenceOutput
@@ -596,34 +637,39 @@ spec
         basicStructModule <-
           (getRight >>> PartialList.head) <$> parseModules ["examples/basicStruct.gotyno"]
         TypeScript.outputModule basicStructModule `shouldBe` tsBasicStruct
+        Haskell.outputModule basicStructModule `shouldBe` hsBasicStruct
         Kotlin.outputModule basicStructModule `shouldBe` ktBasicStruct
         DLang.outputModule basicStructModule `shouldBe` dBasicStruct
 
       it "Mirrors reference output for `basicUnion.gotyno`" $ do
         basicUnionModule <-
           (getRight >>> PartialList.head) <$> parseModules ["examples/basicUnion.gotyno"]
         TypeScript.outputModule basicUnionModule `shouldBe` tsBasicUnion
+        Haskell.outputModule basicUnionModule `shouldBe` hsBasicUnion
         Kotlin.outputModule basicUnionModule `shouldBe` ktBasicUnion
         DLang.outputModule basicUnionModule `shouldBe` dBasicUnion
 
       it "Mirrors reference output for `genericStruct.gotyno`" $ do
         genericStructModule <-
           (getRight >>> PartialList.head) <$> parseModules ["examples/genericStruct.gotyno"]
         TypeScript.outputModule genericStructModule `shouldBe` tsGenericStruct
+        Haskell.outputModule genericStructModule `shouldBe` hsGenericStruct
         Kotlin.outputModule genericStructModule `shouldBe` ktGenericStruct
         DLang.outputModule genericStructModule `shouldBe` dGenericStruct
 
       it "Mirrors reference output for `genericUnion.gotyno`" $ do
         genericUnionModule <-
           (getRight >>> PartialList.head) <$> parseModules ["examples/genericUnion.gotyno"]
         TypeScript.outputModule genericUnionModule `shouldBe` tsGenericUnion
+        Haskell.outputModule genericUnionModule `shouldBe` hsGenericUnion
         Kotlin.outputModule genericUnionModule `shouldBe` ktGenericUnion
         DLang.outputModule genericUnionModule `shouldBe` dGenericUnion
 
       it "Mirrors reference output for `basicEnumeration.gotyno`" $ do
         enumerationModule <-
           (getRight >>> PartialList.head) <$> parseModules ["examples/basicEnumeration.gotyno"]
         TypeScript.outputModule enumerationModule `shouldBe` tsBasicEnumeration
+        Haskell.outputModule enumerationModule `shouldBe` hsBasicEnumeration
         Kotlin.outputModule enumerationModule `shouldBe` ktBasicEnumeration
         DLang.outputModule enumerationModule `shouldBe` dBasicEnumeration
 
@@ -632,13 +678,15 @@ spec
           (getRight >>> PartialList.last)
             <$> parseModules ["examples/basicStruct.gotyno", "examples/basicImport.gotyno"]
         TypeScript.outputModule basicImportModule `shouldBe` tsBasicImport
+        Haskell.outputModule basicImportModule `shouldBe` hsBasicImport
         Kotlin.outputModule basicImportModule `shouldBe` ktBasicImport
         DLang.outputModule basicImportModule `shouldBe` dBasicImport
 
       it "Mirrors reference output for `basicOptional.gotyno`" $ do
         basicOptionalModule <-
           (getRight >>> PartialList.head) <$> parseModules ["examples/basicOptional.gotyno"]
         TypeScript.outputModule basicOptionalModule `shouldBe` tsBasicOptional
+        Haskell.outputModule basicOptionalModule `shouldBe` hsBasicOptional
         Kotlin.outputModule basicOptionalModule `shouldBe` ktBasicOptional
         DLang.outputModule basicOptionalModule `shouldBe` dBasicOptional
 

test/reference-output/basicEnumeration.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module GotynoOutput.BasicEnumeration where
+
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as JSON
+import GHC.Generics (Generic)
+import qualified Gotyno.Helpers as Helpers
+import Qtility
+
+data StringValues
+  = StringValuesFirst
+  | StringValuesSecond
+  | StringValuesThird
+  | StringValuesFourth
+  deriving (Eq, Show, Generic)
+
+instance ToJSON StringValues where
+  toJSON StringValuesFirst = String "first"
+  toJSON StringValuesSecond = String "second"
+  toJSON StringValuesThird = String "Third"
+  toJSON StringValuesFourth = String "Fourth"
+
+instance FromJSON StringValues where
+  parseJSON = Helpers.enumFromJSON [(String "first", StringValuesFirst), (String "second", StringValuesSecond), (String "Third", StringValuesThird), (String "Fourth", StringValuesFourth)]
+
+data IntValues
+  = IntValuesFirst
+  | IntValuesSecond
+  | IntValuesThird
+  | IntValuesFourth
+  deriving (Eq, Show, Generic)
+
+instance ToJSON IntValues where
+  toJSON IntValuesFirst = Number $ fromInteger 1
+  toJSON IntValuesSecond = Number $ fromInteger 2
+  toJSON IntValuesThird = Number $ fromInteger 3
+  toJSON IntValuesFourth = Number $ fromInteger 4
+
+instance FromJSON IntValues where
+  parseJSON = Helpers.enumFromJSON [(Number $ fromInteger 1, IntValuesFirst), (Number $ fromInteger 2, IntValuesSecond), (Number $ fromInteger 3, IntValuesThird), (Number $ fromInteger 4, IntValuesFourth)]

test/reference-output/basicImport.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module GotynoOutput.BasicImport where
+
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as JSON
+import GHC.Generics (Generic)
+import qualified Gotyno.Helpers as Helpers
+import Qtility
+
+import qualified GotynoOutput.BasicStruct as BasicStruct
+
+data StructUsingImport = StructUsingImport
+  { _structUsingImportField :: BasicStruct.BasicStruct
+  }
+  deriving (Eq, Show, Generic)
+
+deriveLensAndJSON ''StructUsingImport
+
+data UnionUsingImport
+  = ConstructorWithPayload BasicStruct.BasicStruct
+  deriving (Eq, Show, Generic)
+
+instance ToJSON UnionUsingImport where
+  toJSON = JSON.genericToJSON $ Helpers.gotynoOptions "type"
+
+instance FromJSON UnionUsingImport where
+  parseJSON = JSON.genericParseJSON $ Helpers.gotynoOptions "type"

test/reference-output/basicOptional.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module GotynoOutput.BasicOptional where
+
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as JSON
+import GHC.Generics (Generic)
+import qualified Gotyno.Helpers as Helpers
+import Qtility
+
+data HasOptionalString = HasOptionalString
+  { _hasOptionalStringStringField :: (Maybe Text),
+    _hasOptionalStringOptionalArrayField :: (Maybe [Int]),
+    _hasOptionalStringArrayOfOptionalField :: [(Maybe Int)]
+  }
+  deriving (Eq, Show, Generic)
+
+deriveLensAndJSON ''HasOptionalString
+
+data HasOptionalConstructor
+  = DoesNot Int
+  | Does (Maybe Int)
+  | HasOptionalStruct (Maybe HasOptionalString)
+  deriving (Eq, Show, Generic)
+
+instance ToJSON HasOptionalConstructor where
+  toJSON = JSON.genericToJSON $ Helpers.gotynoOptions "type"
+
+instance FromJSON HasOptionalConstructor where
+  parseJSON = JSON.genericParseJSON $ Helpers.gotynoOptions "type"

test/reference-output/basicStruct.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module GotynoOutput.BasicStruct where
+
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as JSON
+import GHC.Generics (Generic)
+import qualified Gotyno.Helpers as Helpers
+import Qtility
+
+data BasicStruct = BasicStruct
+  { _basicStructField1 :: Int,
+    _basicStructField2 :: Text
+  }
+  deriving (Eq, Show, Generic)
+
+deriveLensAndJSON ''BasicStruct

test/reference-output/basicUnion.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE StrictData #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module GotynoOutput.BasicUnion where
+
+import Data.Aeson (FromJSON (..), ToJSON (..))
+import qualified Data.Aeson as JSON
+import GHC.Generics (Generic)
+import qualified Gotyno.Helpers as Helpers
+import Qtility
+
+data PayloadStruct = PayloadStruct
+  { _payloadStructField1 :: Int
+  }
+  deriving (Eq, Show, Generic)
+
+deriveLensAndJSON ''PayloadStruct
+
+data BasicUnion
+  = HasStringPayload Text
+  | HasPayload PayloadStruct
+  | HasNoPayload
+  deriving (Eq, Show, Generic)
+
+instance ToJSON BasicUnion where
+  toJSON = JSON.genericToJSON $ Helpers.gotynoOptions "type"
+
+instance FromJSON BasicUnion where
+  parseJSON = JSON.genericParseJSON $ Helpers.gotynoOptions "type"