refactor: generate sumtype via template (#3)

.github/workflows/haskell.yml

@@ -2,7 +2,7 @@ name: build-test-check
 
 on:
   push:
-    branches: ["master"]
+    branches: "*"
   pull_request:
     branches: ["master"]
 
@@ -12,9 +12,10 @@ permissions:
 jobs:
   build:
     runs-on: ubuntu-latest
-
     steps:
       - uses: actions/checkout@v3
+        with:
+          submodules: true
       - uses: haskell-actions/setup@v2
         with:
           ghc-version: "9.4.8"

.gitmodules

@@ -0,0 +1,3 @@
+[submodule "src/Lib/x-sum-type-boilerplate"]
+	path = src/Lib/x-sum-type-boilerplate
+	url = https://github.com/xieyuschen/x-sum-type-boilerplate

slinter.cabal

@@ -7,6 +7,20 @@ author:             xieyuschen
 maintainer:         [email protected]
 build-type:         Simple
 extra-doc-files:    CHANGELOG.md
+
+-- todo: remove this after I upload my forked version to hackage
+-- https://github.com/xieyuschen/x-sum-type-boilerplate
+library x-sum-type-boilerplate
+  exposed-modules:
+      SumTypes.TH
+  hs-source-dirs:
+      src/Lib/x-sum-type-boilerplate/library
+  ghc-options: -Wall
+  build-depends:
+      base >= 4.1 && < 4.20
+    , template-haskell
+  default-language: Haskell2010
+
 common warnings
     ghc-options: -Wall
 
@@ -20,7 +34,10 @@ common common-depends
         text,
         bytestring,
         hspec,
-        parsec ^>=3.1.16.1
+        parsec ^>=3.1.16.1,
+        -- force to use my forked version
+        x-sum-type-boilerplate
+
 library internallib
     import: common-depends
     exposed-modules:

src/Lib/AST/Definition.hs

@@ -7,7 +7,7 @@ import Data.Functor (($>))
 import Data.Maybe (fromMaybe, listToMaybe)
 import Lib.AST.Expr (pFnCallArgs)
 import Lib.AST.Function (pFnDeclModifierInvocation, pFunctionDefinition)
-import Lib.AST.Model (ConstructorDefinition (..), ConstructorMutability (..), ContractBody (..), ContractBodyFieldSum (..), ErrorDefinition (..), ErrorParameter (ErrorParameter, errParamName, errParamType), EventDefinition (..), EventParameter (..), FnDecorator (..), FnModifierInvocation, FnName (..), FunctionDefinition (fnDefName), InheritanceSpecifier (..), InterfaceDefinition (..), LibraryDefinition (..), ModifierDefinition (..), extractFnDecOs, leftCurlyBrace, leftParenthesis, rightCurlyBrace, rightParenthesis, semicolon)
+import Lib.AST.Model (ConstructorDefinition (..), ConstructorMutability (..), ContractBody (..), ErrorDefinition (..), ErrorParameter (ErrorParameter, errParamName, errParamType), EventDefinition (..), EventParameter (..), FnDecorator (..), FnModifierInvocation, FnName (..), FunctionDefinition (fnDefName), InheritanceSpecifier (..), InterfaceDefinition (..), LibraryDefinition (..), ModifierDefinition (..), extractFnDecOs, leftCurlyBrace, leftParenthesis, rightCurlyBrace, rightParenthesis, semicolon, CBFSSum (..))
 import Lib.AST.Pragma (pComment, pUsingDirective)
 import Lib.AST.Stat (pState, pStateVariable)
 import Lib.AST.Type (pInt, pType, pTypeEnum, pTypeStruct, pUserDefinedValueTypeDefinition)
@@ -170,10 +170,10 @@ pContractBody :: Parser ContractBody
 pContractBody = do
   all <-
     sepEndBy
-      ( try pComment $> CBFSSumComments
+      (   CBFSSumComment <$> try pComment 
           <|> CBFSSumUsingDirective <$> try pUsingDirective
-          <|> CBFSSumConstructor <$> try pConstructorDefinition
-          <|> CBFSSumFunction <$> try pFunctionDefinition
+          <|> CBFSSumConstructorDefinition <$> try pConstructorDefinition
+          <|> CBFSSumFunctionDefinition <$> try pFunctionDefinition
           <|> CBFSSumModifierDefinition <$> try pModifierDefinition
           <|> CBFSSumStructure <$> try pTypeStruct
           <|> CBFSSumSTypeEnum <$> try pTypeEnum
@@ -188,7 +188,7 @@ pContractBody = do
   return $
     ContractBody
       { ctBodyConstructor = Nothing,
-        ctBodyFunctions = [v | CBFSSumFunction v <- all],
+        ctBodyFunctions = [v | CBFSSumFunctionDefinition v <- all],
         ctBodyModifiers = [v | CBFSSumModifierDefinition v <- all],
         ctBodyStructDefinitions = [v | CBFSSumStructure v <- all],
         ctBodyEnumDefinitions = [v | CBFSSumSTypeEnum v <- all],
@@ -197,9 +197,9 @@ pContractBody = do
         ctBodyEventDefinitions = [v | CBFSSumEventDefinition v <- all],
         ctBodyErrorDefinitions = [v | CBFSSumErrorDefinition v <- all],
         ctBodyUsingDirectives = [v | CBFSSumUsingDirective v <- all],
-        ctBodyReceiveFunctions = filter (\f -> fnDefName f == FnReceive) [v | CBFSSumFunction v <- all],
-        ctBodyFallbackFunctions = filter (\f -> fnDefName f == FnFallback) [v | CBFSSumFunction v <- all],
-        ctBodyAllFields = all
+        ctBodyReceiveFunctions = filter (\f -> fnDefName f == FnReceive) [v | CBFSSumFunctionDefinition v <- all],
+        ctBodyFallbackFunctions = filter (\f -> fnDefName f == FnFallback) [v | CBFSSumFunctionDefinition v <- all]
+        -- ctBodyAllFields = all
       }
 
 pInterfaceDefinition :: Parser InterfaceDefinition

src/Lib/AST/File.hs

@@ -0,0 +1,2 @@
+module Lib.AST.File where
+

src/Lib/AST/Model.hs

@@ -1,9 +1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 module Lib.AST.Model where
 
 import Data.Text (Text)
 import Lib.Parser (SemVer)
+import SumTypes.TH
 
 keywordLogicalOr :: Text
 keywordLogicalOr = "||"
@@ -562,21 +565,6 @@ data ContractBodyField
   | CtEmptyLine
   deriving (Show, Eq)
 
-data ContractBodyFieldSum
-  = CBFSSumConstructor ConstructorDefinition
-  | CBFSSumFunction FunctionDefinition
-  | CBFSSumModifierDefinition ModifierDefinition
-  | CBFSSumStructure Structure
-  | CBFSSumSTypeEnum STypeEnum
-  | CBFSSumUserDefinedValueTypeDefinition UserDefinedValueTypeDefinition
-  | CBFSSumStateVariable StateVariable
-  | CBFSSumEventDefinition EventDefinition
-  | CBFSSumErrorDefinition ErrorDefinition
-  | CBFSSumUsingDirective UsingDirective
-  | CBFSSumContractBodyFieldSum ContractBodyFieldSum
-  | CBFSSumComments
-  deriving (Show, Eq)
-
 data ContractBody = ContractBody
   { ctBodyConstructor :: Maybe ConstructorDefinition,
     ctBodyFunctions :: [FunctionDefinition],
@@ -589,7 +577,41 @@ data ContractBody = ContractBody
     ctBodyStateVariables :: [StateVariable],
     ctBodyEventDefinitions :: [EventDefinition],
     ctBodyErrorDefinitions :: [ErrorDefinition],
-    ctBodyUsingDirectives :: [UsingDirective],
-    ctBodyAllFields :: [ContractBodyFieldSum]
-  }
-  deriving (Show, Eq)
+    ctBodyUsingDirectives :: [UsingDirective]
+    -- todo: fix me: when using haskell template to generate the code,
+    -- the code place in the file matters
+    -- the generated CBFSSum type cannot be referenced at the code above the 'constructSumType'
+    -- however, when i move the data definition below the other structures cannot visit 'ContractBody'
+    --ctBodyAllFields :: [CBFSSum]
+  }
+  deriving (Show, Eq)
+
+constructSumType "CBFSSum" defaultSumTypeOptions [
+  ''ConstructorDefinition, ''FunctionDefinition, ''ModifierDefinition
+  , ''Structure, ''STypeEnum, ''UserDefinedValueTypeDefinition
+  , ''StateVariable, ''EventDefinition , ''ErrorDefinition 
+  , ''UsingDirective , ''Comment
+  ]
+
+deriving instance Show CBFSSum
+deriving instance Eq CBFSSum
+
+-- SolFile stands all definitions and the filename of a sol file,
+-- which typically ends with file extension `.sol`
+data SolFile = SolFile {
+  solFileName :: String, 
+  solPragma :: Pragma,
+  solSpdxLicense :: SPDXComment,
+  solImprotDirectives :: [ImportDirective],
+  solUsingDirectives :: [UsingDirective],
+  solContracts :: [ContractDefinition],
+  solInterfaces :: [InterfaceDefinition],
+  solLibraries :: [LibraryDefinition],
+  solFunctions :: [FunctionDefinition],
+  solConstantVars :: [StateVariable],
+  solStructs:: [Structure],
+  solEnums :: [STypeEnum],
+  solUserDefineValueType :: [UserDefinedValueTypeDefinition],
+  solErrors :: [ErrorDefinition],
+  solEvents :: [EventDefinition]
+}  deriving (Show, Eq)

tests/Lib/AST/DefinitionSpec.hs

@@ -325,8 +325,8 @@ parseInterfaceDefintionSpec = do
                           ctBodyStateVariables = [],
                           ctBodyEventDefinitions = [],
                           ctBodyErrorDefinitions = [],
-                          ctBodyUsingDirectives = [],
-                          ctBodyAllFields = [CBFSSumFunction (FunctionDefinition {fnDefName = FnNormal "getResult", fnState = FnStateView, fnVisibility = FnExternal, fnModifierInvocations = [], fnFnOverrideSpecifier = Nothing, fnIsVirtual = False, fargs = [], fnReturnTyp = Just (STypeUint 256), fnBody = Nothing})]
+                          ctBodyUsingDirectives = []
+                          -- ctBodyAllFields = [CBFSSumFunctionDefinition (FunctionDefinition {fnDefName = FnNormal "getResult", fnState = FnStateView, fnVisibility = FnExternal, fnModifierInvocations = [], fnFnOverrideSpecifier = Nothing, fnIsVirtual = False, fargs = [], fnReturnTyp = Just (STypeUint 256), fnBody = Nothing})]
                         }
                   }
               ),
@@ -352,8 +352,8 @@ parseInterfaceDefintionSpec = do
                           ctBodyStateVariables = [],
                           ctBodyEventDefinitions = [],
                           ctBodyErrorDefinitions = [],
-                          ctBodyUsingDirectives = [],
-                          ctBodyAllFields = [CBFSSumFunction (FunctionDefinition {fnDefName = FnNormal "getResult", fnState = FnStateView, fnVisibility = FnExternal, fnModifierInvocations = [], fnFnOverrideSpecifier = Nothing, fnIsVirtual = False, fargs = [], fnReturnTyp = Just (STypeUint 256), fnBody = Nothing})]
+                          ctBodyUsingDirectives = []
+                          -- ctBodyAllFields = [CBFSSumFunctionDefinition (FunctionDefinition {fnDefName = FnNormal "getResult", fnState = FnStateView, fnVisibility = FnExternal, fnModifierInvocations = [], fnFnOverrideSpecifier = Nothing, fnIsVirtual = False, fargs = [], fnReturnTyp = Just (STypeUint 256), fnBody = Nothing})]
                         }
                   }
               ),
@@ -385,8 +385,8 @@ parseInterfaceDefintionSpec = do
                           ctBodyStateVariables = [],
                           ctBodyEventDefinitions = [],
                           ctBodyErrorDefinitions = [],
-                          ctBodyUsingDirectives = [],
-                          ctBodyAllFields = [CBFSSumFunction (FunctionDefinition {fnDefName = FnNormal "getResult", fnState = FnStateView, fnVisibility = FnExternal, fnModifierInvocations = [], fnFnOverrideSpecifier = Nothing, fnIsVirtual = False, fargs = [], fnReturnTyp = Just (STypeUint 256), fnBody = Nothing})]
+                          ctBodyUsingDirectives = []
+                          -- ctBodyAllFields = [CBFSSumFunctionDefinition (FunctionDefinition {fnDefName = FnNormal "getResult", fnState = FnStateView, fnVisibility = FnExternal, fnModifierInvocations = [], fnFnOverrideSpecifier = Nothing, fnIsVirtual = False, fargs = [], fnReturnTyp = Just (STypeUint 256), fnBody = Nothing})]
                         }
                   }
               ),
@@ -404,7 +404,9 @@ parseLibraryDefinitionSpec :: Spec
 parseLibraryDefinitionSpec = do
   let testCases =
         [ ( "library Lib{}",
-            Right (LibraryDefinition {libraryName = "Lib", libraryBody = ContractBody {ctBodyConstructor = Nothing, ctBodyFunctions = [], ctBodyModifiers = [], ctBodyFallbackFunctions = [], ctBodyReceiveFunctions = [], ctBodyStructDefinitions = [], ctBodyEnumDefinitions = [], ctBodyUserDefinedValueTypeDefinition = [], ctBodyStateVariables = [], ctBodyEventDefinitions = [], ctBodyErrorDefinitions = [], ctBodyUsingDirectives = [], ctBodyAllFields = []}}),
+            Right (LibraryDefinition {libraryName = "Lib", libraryBody = ContractBody {ctBodyConstructor = Nothing, ctBodyFunctions = [], ctBodyModifiers = [], ctBodyFallbackFunctions = [], ctBodyReceiveFunctions = [], ctBodyStructDefinitions = [], ctBodyEnumDefinitions = [], ctBodyUserDefinedValueTypeDefinition = [], ctBodyStateVariables = [], ctBodyEventDefinitions = [], ctBodyErrorDefinitions = [], ctBodyUsingDirectives = []
+            -- , ctBodyAllFields = []
+            }}),
             ""
           ),
           ( "library Lib{function getResult() external view returns(uint);}",
@@ -424,8 +426,8 @@ parseLibraryDefinitionSpec = do
                           ctBodyStateVariables = [],
                           ctBodyEventDefinitions = [],
                           ctBodyErrorDefinitions = [],
-                          ctBodyUsingDirectives = [],
-                          ctBodyAllFields = [CBFSSumFunction (FunctionDefinition {fnDefName = FnNormal "getResult", fnState = FnStateView, fnVisibility = FnExternal, fnModifierInvocations = [], fnFnOverrideSpecifier = Nothing, fnIsVirtual = False, fargs = [], fnReturnTyp = Just (STypeUint 256), fnBody = Nothing})]
+                          ctBodyUsingDirectives = []
+                          -- ctBodyAllFields = [CBFSSumFunctionDefinition (FunctionDefinition {fnDefName = FnNormal "getResult", fnState = FnStateView, fnVisibility = FnExternal, fnModifierInvocations = [], fnFnOverrideSpecifier = Nothing, fnIsVirtual = False, fargs = [], fnReturnTyp = Just (STypeUint 256), fnBody = Nothing})]
                         }
                   }
               ),