Dhall.TH: Configurable {From,To}Dhall instances

This commit adds two fields to both constructors of
`Dhall.TH.HaskellType`: One flag to control whether a `FromDhall`
instance will be generated and one to control whether a `ToDhall`
instance will be generated.

Author: mmhat

dhall/src/Dhall/TH.hs

@@ -179,11 +179,14 @@ toNestedHaskellType haskellTypes = loop
             predicate haskellType =
                 Core.judgmentallyEqual (code haskellType) dhallType
 
-derivingClauses :: [DerivClause]
-derivingClauses =
-    [ DerivClause (Just StockStrategy) [ ConT ''Generic ]
-    , DerivClause (Just AnyclassStrategy) [ ConT ''FromDhall, ConT ''ToDhall ]
-    ]
+derivingGenericClause :: DerivClause
+derivingGenericClause = DerivClause (Just StockStrategy) [ ConT ''Generic ]
+
+derivingFromClause :: DerivClause
+derivingFromClause = DerivClause (Just AnyclassStrategy) [ ConT ''FromDhall ]
+
+derivingToClause :: DerivClause
+derivingToClause = DerivClause (Just AnyclassStrategy) [ ConT ''ToDhall ]
 
 -- | Convert a Dhall type to the corresponding Haskell datatype declaration
 toDeclaration
@@ -196,6 +199,11 @@ toDeclaration haskellTypes MultipleConstructors{..} =
         Union kts -> do
             let name = Syntax.mkName (Text.unpack typeName)
 
+            let derivingClauses =
+                    [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] <>
+                    [ derivingFromClause | generateFromDhallInstance ] <>
+                    [ derivingToClause | generateToDhallInstance ]
+
             constructors <- traverse (toConstructor haskellTypes typeName) (Dhall.Map.toList kts )
 
             return (DataD [] name [] Nothing constructors derivingClauses)
@@ -245,6 +253,11 @@ toDeclaration haskellTypes MultipleConstructors{..} =
 toDeclaration haskellTypes SingleConstructor{..} = do
     let name = Syntax.mkName (Text.unpack typeName)
 
+    let derivingClauses =
+            [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] <>
+            [ derivingFromClause | generateFromDhallInstance ] <>
+            [ derivingToClause | generateToDhallInstance ]
+
     constructor <- toConstructor haskellTypes typeName (constructorName, Just code)
 
     return (DataD [] name [] Nothing [constructor] derivingClauses)
@@ -306,15 +319,19 @@ toConstructor haskellTypes outerTypeName (constructorName, maybeAlternativeType)
 -- This is a special case of `Dhall.TH.makeHaskellTypes`:
 --
 -- > makeHaskellTypeFromUnion typeName code =
--- >     makeHaskellTypes [ MultipleConstructors{..} ]
+-- >    let generateFromDhallInstance = True
+-- >        generateToDhallInstance = True
+-- >    in makeHaskellTypes [ MultipleConstructors{..} ]
 makeHaskellTypeFromUnion
     :: Text
     -- ^ Name of the generated Haskell type
     -> Text
     -- ^ Dhall code that evaluates to a union type
     -> Q [Dec]
 makeHaskellTypeFromUnion typeName code =
-    makeHaskellTypes [ MultipleConstructors{..} ]
+    let generateFromDhallInstance = True
+        generateToDhallInstance = True
+    in makeHaskellTypes [ MultipleConstructors{..} ]
 
 -- | Used by `makeHaskellTypes` to specify how to generate Haskell types
 data HaskellType code
@@ -323,6 +340,10 @@ data HaskellType code
     = MultipleConstructors
         { typeName :: Text
         -- ^ Name of the generated Haskell type
+        , generateFromDhallInstance :: Bool
+        -- ^ Generate a `FromDhall` instance for the Haskell type
+        , generateToDhallInstance :: Bool
+        -- ^ Generate a `ToDhall` instance for the Haskell type
         , code :: code
         -- ^ Dhall code that evaluates to a union type
         }
@@ -335,6 +356,10 @@ data HaskellType code
         -- ^ Name of the generated Haskell type
         , constructorName :: Text
         -- ^ Name of the constructor
+        , generateFromDhallInstance :: Bool
+        -- ^ Generate a `FromDhall` instance for the Haskell type
+        , generateToDhallInstance :: Bool
+        -- ^ Generate a `ToDhall` instance for the Haskell type
         , code :: code
         -- ^ Dhall code that evaluates to a type
         }

dhall/tests/Dhall/Test/TH.hs

@@ -21,8 +21,8 @@ deriving instance Eq   T
 deriving instance Show T
 
 Dhall.TH.makeHaskellTypes
-    [ MultipleConstructors "Department" "./tests/th/Department.dhall"
-    , SingleConstructor "Employee" "MakeEmployee" "./tests/th/Employee.dhall"
+    [ MultipleConstructors "Department" True True "./tests/th/Department.dhall"
+    , SingleConstructor "Employee" "MakeEmployee" True True "./tests/th/Employee.dhall"
     ]
 
 deriving instance Eq   Department
@@ -32,9 +32,9 @@ deriving instance Eq   Employee
 deriving instance Show Employee
 
 Dhall.TH.makeHaskellTypes
-  [ SingleConstructor "Bar" "MakeBar" "(./tests/th/issue2066.dhall).Bar"
-  , SingleConstructor "Foo" "MakeFoo" "(./tests/th/issue2066.dhall).Foo"
-  , MultipleConstructors "Qux" "(./tests/th/issue2066.dhall).Qux"
+  [ SingleConstructor "Bar" "MakeBar" True True "(./tests/th/issue2066.dhall).Bar"
+  , SingleConstructor "Foo" "MakeFoo" True True "(./tests/th/issue2066.dhall).Foo"
+  , MultipleConstructors "Qux" True True "(./tests/th/issue2066.dhall).Qux"
   ]
 
 deriving instance Eq   Bar