From b8fd86e867ea6f23e24104fe35a9cfba67c8f653 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Sat, 21 Aug 2021 20:11:10 +0200 Subject: [PATCH 01/12] 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. --- dhall/src/Dhall/TH.hs | 39 +++++++++++++++++++++++++++++------- dhall/tests/Dhall/Test/TH.hs | 10 ++++----- 2 files changed, 37 insertions(+), 12 deletions(-) diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs index caf0ca37d..c396a21ae 100644 --- a/dhall/src/Dhall/TH.hs +++ b/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,7 +319,9 @@ 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 @@ -314,7 +329,9 @@ makeHaskellTypeFromUnion -- ^ 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 } diff --git a/dhall/tests/Dhall/Test/TH.hs b/dhall/tests/Dhall/Test/TH.hs index 7ef45d621..9607c4f2f 100644 --- a/dhall/tests/Dhall/Test/TH.hs +++ b/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 From 3bba65e7e317e06a001ce4f11eaab9eab92cf693 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Tue, 7 Sep 2021 17:52:54 +0200 Subject: [PATCH 02/12] Moved options related to code generation to own data type --- dhall/src/Dhall/TH.hs | 63 ++++++++++++++++++++++++++++--------------- 1 file changed, 42 insertions(+), 21 deletions(-) diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs index c396a21ae..dedb696a3 100644 --- a/dhall/src/Dhall/TH.hs +++ b/dhall/src/Dhall/TH.hs @@ -6,12 +6,16 @@ -- | Template Haskell utilities module Dhall.TH - ( -- * Template Haskell + ( -- * Embedding Dhall in Haskell staticDhallExpression , dhall + -- * Generating Haskell from Dhall expressions , makeHaskellTypeFromUnion , makeHaskellTypes + , makeHaskellTypesWith , HaskellType(..) + , GenerateOptions(..) + , defaultGenerateOptions ) where import Data.Text (Text) @@ -191,10 +195,11 @@ derivingToClause = DerivClause (Just AnyclassStrategy) [ ConT ''ToDhall ] -- | Convert a Dhall type to the corresponding Haskell datatype declaration toDeclaration :: (Eq a, Pretty a) - => [HaskellType (Expr s a)] + => GenerateOptions + -> [HaskellType (Expr s a)] -> HaskellType (Expr s a) -> Q Dec -toDeclaration haskellTypes MultipleConstructors{..} = +toDeclaration GenerateOptions{..} haskellTypes MultipleConstructors{..} = case code of Union kts -> do let name = Syntax.mkName (Text.unpack typeName) @@ -250,7 +255,7 @@ toDeclaration haskellTypes MultipleConstructors{..} = let message = Pretty.renderString (Dhall.Pretty.layout document) fail message -toDeclaration haskellTypes SingleConstructor{..} = do +toDeclaration GenerateOptions{..} haskellTypes SingleConstructor{..} = do let name = Syntax.mkName (Text.unpack typeName) let derivingClauses = @@ -319,9 +324,7 @@ toConstructor haskellTypes outerTypeName (constructorName, maybeAlternativeType) -- This is a special case of `Dhall.TH.makeHaskellTypes`: -- -- > makeHaskellTypeFromUnion typeName code = --- > let generateFromDhallInstance = True --- > generateToDhallInstance = True --- > in makeHaskellTypes [ MultipleConstructors{..} ] +-- > makeHaskellTypes [ MultipleConstructors{..} ] makeHaskellTypeFromUnion :: Text -- ^ Name of the generated Haskell type @@ -329,21 +332,16 @@ makeHaskellTypeFromUnion -- ^ Dhall code that evaluates to a union type -> Q [Dec] makeHaskellTypeFromUnion typeName code = - let generateFromDhallInstance = True - generateToDhallInstance = True - in makeHaskellTypes [ MultipleConstructors{..} ] + makeHaskellTypes [ MultipleConstructors{..} ] --- | Used by `makeHaskellTypes` to specify how to generate Haskell types +-- | Used by `makeHaskellTypes` and `makeHaskellTypesWith` to specify how to +-- generate Haskell types data HaskellType code -- | Generate a Haskell type with more than one constructor from a Dhall -- union type = 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 } @@ -356,15 +354,29 @@ 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 } deriving (Functor, Foldable, Traversable) +-- | This data type holds various options that let you control several aspects +-- how Haskell code is generated. In particular you can +-- +-- * disable the generation of `FromDhall`/`ToDhall` instances. +data GenerateOptions = GenerateOptions + { generateFromDhallInstance :: Bool + -- ^ Generate a `FromDhall` instance for the Haskell type + , generateToDhallInstance :: Bool + -- ^ Generate a `ToDhall` instance for the Haskell type + } + +-- | A default set of options used by `makeHaskellTypes`. +defaultGenerateOptions :: GenerateOptions +defaultGenerateOptions = GenerateOptions + { generateFromDhallInstance = True + , generateToDhallInstance = False + } + -- | Generate a Haskell datatype declaration with one constructor from a Dhall -- type -- @@ -441,9 +453,18 @@ data HaskellType code -- > deriving instance Ord Employee -- > deriving instance Show Employee makeHaskellTypes :: [HaskellType Text] -> Q [Dec] -makeHaskellTypes haskellTypes = do +makeHaskellTypes = makeHaskellTypesWith defaultGenerateOptions + +-- | Like `makeHaskellTypes`, but with the ability to customize the generated +-- Haskell code by passing `GenerateOptions`. +-- +-- For instance, `makeHaskellTypes` is implemented using this function: +-- +-- > makeHaskellTypes = makeHaskellTypesWith defaultGenerateOptions +makeHaskellTypesWith :: GenerateOptions -> [HaskellType Text] -> Q [Dec] +makeHaskellTypesWith generateOptions haskellTypes = do Syntax.runIO (GHC.IO.Encoding.setLocaleEncoding System.IO.utf8) haskellTypes' <- traverse (traverse (Syntax.runIO . Dhall.inputExpr)) haskellTypes - traverse (toDeclaration haskellTypes') haskellTypes' + traverse (toDeclaration generateOptions haskellTypes') haskellTypes' From 44df22c6f39db6bc04bce72e6b2a20ada390757a Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Tue, 7 Sep 2021 21:35:37 +0200 Subject: [PATCH 03/12] Fixed tests --- dhall/tests/Dhall/Test/TH.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/dhall/tests/Dhall/Test/TH.hs b/dhall/tests/Dhall/Test/TH.hs index 9607c4f2f..7ef45d621 100644 --- a/dhall/tests/Dhall/Test/TH.hs +++ b/dhall/tests/Dhall/Test/TH.hs @@ -21,8 +21,8 @@ deriving instance Eq T deriving instance Show T Dhall.TH.makeHaskellTypes - [ MultipleConstructors "Department" True True "./tests/th/Department.dhall" - , SingleConstructor "Employee" "MakeEmployee" True True "./tests/th/Employee.dhall" + [ MultipleConstructors "Department" "./tests/th/Department.dhall" + , SingleConstructor "Employee" "MakeEmployee" "./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" 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" + [ SingleConstructor "Bar" "MakeBar" "(./tests/th/issue2066.dhall).Bar" + , SingleConstructor "Foo" "MakeFoo" "(./tests/th/issue2066.dhall).Foo" + , MultipleConstructors "Qux" "(./tests/th/issue2066.dhall).Qux" ] deriving instance Eq Bar From 268cf2183315ca2969ac4321047fb13f4c47d18b Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Tue, 7 Sep 2021 19:06:48 +0200 Subject: [PATCH 04/12] Generate {From,To}Dhall instances explicitly --- dhall/src/Dhall/Marshal/Decode.hs | 13 +++++++--- dhall/src/Dhall/Marshal/Encode.hs | 17 +++++++++---- dhall/src/Dhall/TH.hs | 40 ++++++++++++++++++------------- 3 files changed, 47 insertions(+), 23 deletions(-) diff --git a/dhall/src/Dhall/Marshal/Decode.hs b/dhall/src/Dhall/Marshal/Decode.hs index 5b533585b..ce2b4d2e5 100644 --- a/dhall/src/Dhall/Marshal/Decode.hs +++ b/dhall/src/Dhall/Marshal/Decode.hs @@ -90,6 +90,7 @@ module Dhall.Marshal.Decode , GenericFromDhallUnion(..) , genericAuto , genericAutoWith + , genericAutoWithInputNormalizer -- * Decoding errors , DhallErrors(..) @@ -221,8 +222,8 @@ fromList [("a",False),("b",True)] implement `Generic`. This does not auto-generate an instance for recursive types. - The default instance can be tweaked using 'genericAutoWith' and custom - 'InterpretOptions', or using + The default instance can be tweaked using 'genericAutoWith'/'genericAutoWithInputNormalizer' + and custom 'InterpretOptions', or using [DerivingVia](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DerivingVia) and 'Dhall.Deriving.Codec' from "Dhall.Deriving". -} @@ -687,7 +688,13 @@ genericAuto = genericAutoWith defaultInterpretOptions {-| `genericAutoWith` is a configurable version of `genericAuto`. -} genericAutoWith :: (Generic a, GenericFromDhall a (Rep a)) => InterpretOptions -> Decoder a -genericAutoWith options = withProxy (\p -> fmap to (evalState (genericAutoWithNormalizer p defaultInputNormalizer options) 1)) +genericAutoWith options = genericAutoWithInputNormalizer options defaultInputNormalizer + +{-| `genericAutoWithInputNormalizer` is like `genericAutoWith`, but instead of + using the `defaultInputNormalizer` it expects an custom `InputNormalizer`. +-} +genericAutoWithInputNormalizer :: (Generic a, GenericFromDhall a (Rep a)) => InterpretOptions -> InputNormalizer -> Decoder a +genericAutoWithInputNormalizer options inputNormalizer = withProxy (\p -> fmap to (evalState (genericAutoWithNormalizer p inputNormalizer options) 1)) where withProxy :: (Proxy a -> Decoder a) -> Decoder a withProxy f = f Proxy diff --git a/dhall/src/Dhall/Marshal/Encode.hs b/dhall/src/Dhall/Marshal/Encode.hs index 545ae6f82..fcdfed363 100644 --- a/dhall/src/Dhall/Marshal/Encode.hs +++ b/dhall/src/Dhall/Marshal/Encode.hs @@ -41,6 +41,7 @@ module Dhall.Marshal.Encode , GenericToDhall(..) , genericToDhall , genericToDhallWith + , genericToDhallWithInputNormalizer , InterpretOptions(..) , SingletonConstructors(..) , defaultInterpretOptions @@ -127,8 +128,8 @@ instance Contravariant Encoder where implement `Generic`. This does not auto-generate an instance for recursive types. - The default instance can be tweaked using 'genericToDhallWith' and custom - 'InterpretOptions', or using + The default instance can be tweaked using 'genericToDhallWith'/'genericToDhallWithInputNormalizer' + and custom 'InterpretOptions', or using [DerivingVia](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-DerivingVia) and 'Dhall.Deriving.Codec' from "Dhall.Deriving". -} @@ -725,8 +726,16 @@ want to define orphan instances for. -} genericToDhallWith :: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> Encoder a -genericToDhallWith options - = contramap GHC.Generics.from (evalState (genericToDhallWithNormalizer defaultInputNormalizer options) 1) +genericToDhallWith options = genericToDhallWithInputNormalizer options defaultInputNormalizer + +{-| `genericToDhallWithInputNormalizer` is like `genericToDhallWith`, but + instead of using the `defaultInputNormalizer` it expects an custom + `InputNormalizer`. +-} +genericToDhallWithInputNormalizer + :: (Generic a, GenericToDhall (Rep a)) => InterpretOptions -> InputNormalizer -> Encoder a +genericToDhallWithInputNormalizer options inputNormalizer + = contramap GHC.Generics.from (evalState (genericToDhallWithNormalizer inputNormalizer options) 1) diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs index dedb696a3..30b689e38 100644 --- a/dhall/src/Dhall/TH.hs +++ b/dhall/src/Dhall/TH.hs @@ -186,11 +186,17 @@ toNestedHaskellType haskellTypes = loop derivingGenericClause :: DerivClause derivingGenericClause = DerivClause (Just StockStrategy) [ ConT ''Generic ] -derivingFromClause :: DerivClause -derivingFromClause = DerivClause (Just AnyclassStrategy) [ ConT ''FromDhall ] - -derivingToClause :: DerivClause -derivingToClause = DerivClause (Just AnyclassStrategy) [ ConT ''ToDhall ] +fromDhallInstance :: Syntax.Name -> Q Exp -> Q [Dec] +fromDhallInstance n interpretOptions = [d| + instance FromDhall $(pure $ ConT n) where + autoWith = Dhall.genericAutoWithInputNormalizer $(interpretOptions) + |] + +toDhallInstance :: Syntax.Name -> Q Exp -> Q [Dec] +toDhallInstance n interpretOptions = [d| + instance ToDhall $(pure $ ConT n) where + injectWith = Dhall.genericToDhallWithInputNormalizer $(interpretOptions) + |] -- | Convert a Dhall type to the corresponding Haskell datatype declaration toDeclaration @@ -198,20 +204,21 @@ toDeclaration => GenerateOptions -> [HaskellType (Expr s a)] -> HaskellType (Expr s a) - -> Q Dec -toDeclaration GenerateOptions{..} haskellTypes MultipleConstructors{..} = + -> Q [Dec] +toDeclaration generateOptions@GenerateOptions{..} haskellTypes MultipleConstructors{..} = case code of Union kts -> do let name = Syntax.mkName (Text.unpack typeName) let derivingClauses = - [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] <> - [ derivingFromClause | generateFromDhallInstance ] <> - [ derivingToClause | generateToDhallInstance ] + [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] constructors <- traverse (toConstructor haskellTypes typeName) (Dhall.Map.toList kts ) - return (DataD [] name [] Nothing constructors derivingClauses) + fmap concat . sequence $ + [pure [DataD [] name [] Nothing constructors derivingClauses]] <> + [ fromDhallInstance name [|Dhall.defaultInterpretOptions|] | generateFromDhallInstance ] <> + [ toDhallInstance name [|Dhall.defaultInterpretOptions|] | generateToDhallInstance ] _ -> do let document = @@ -259,13 +266,14 @@ toDeclaration GenerateOptions{..} haskellTypes SingleConstructor{..} = do let name = Syntax.mkName (Text.unpack typeName) let derivingClauses = - [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] <> - [ derivingFromClause | generateFromDhallInstance ] <> - [ derivingToClause | generateToDhallInstance ] + [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] constructor <- toConstructor haskellTypes typeName (constructorName, Just code) - return (DataD [] name [] Nothing [constructor] derivingClauses) + fmap concat . sequence $ + [pure [DataD [] name [] Nothing [constructor] derivingClauses]] <> + [ fromDhallInstance name [|Dhall.defaultInterpretOptions|] | generateFromDhallInstance ] <> + [ toDhallInstance name [|Dhall.defaultInterpretOptions|] | generateToDhallInstance ] -- | Convert a Dhall type to the corresponding Haskell constructor toConstructor @@ -467,4 +475,4 @@ makeHaskellTypesWith generateOptions haskellTypes = do haskellTypes' <- traverse (traverse (Syntax.runIO . Dhall.inputExpr)) haskellTypes - traverse (toDeclaration generateOptions haskellTypes') haskellTypes' + concat <$> traverse (toDeclaration generateOptions haskellTypes') haskellTypes' From d074b24a061684f54023b26fd1f00694a5da4ef3 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Tue, 7 Sep 2021 18:14:46 +0200 Subject: [PATCH 05/12] Implementend `constructorModifier` This function controls how a Dhall union field is mapped to a Haskell data constructor. --- dhall/src/Dhall/TH.hs | 72 ++++++++++++++++++++++++++++++++++--------- 1 file changed, 58 insertions(+), 14 deletions(-) diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs index 30b689e38..bc0d7d191 100644 --- a/dhall/src/Dhall/TH.hs +++ b/dhall/src/Dhall/TH.hs @@ -30,6 +30,7 @@ import Language.Haskell.TH.Syntax , Con (..) , Dec (..) , Exp (..) + , Pat , Q , SourceStrictness (..) , SourceUnpackedness (..) @@ -205,7 +206,7 @@ toDeclaration -> [HaskellType (Expr s a)] -> HaskellType (Expr s a) -> Q [Dec] -toDeclaration generateOptions@GenerateOptions{..} haskellTypes MultipleConstructors{..} = +toDeclaration generateOptions@GenerateOptions{..} haskellTypes typ@MultipleConstructors{..} = case code of Union kts -> do let name = Syntax.mkName (Text.unpack typeName) @@ -213,12 +214,14 @@ toDeclaration generateOptions@GenerateOptions{..} haskellTypes MultipleConstruct let derivingClauses = [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] - constructors <- traverse (toConstructor haskellTypes typeName) (Dhall.Map.toList kts ) + constructors <- traverse (toConstructor generateOptions haskellTypes typeName) (Dhall.Map.toList kts) + + let interpretOptions = generateToInterpretOptions generateOptions typ fmap concat . sequence $ [pure [DataD [] name [] Nothing constructors derivingClauses]] <> - [ fromDhallInstance name [|Dhall.defaultInterpretOptions|] | generateFromDhallInstance ] <> - [ toDhallInstance name [|Dhall.defaultInterpretOptions|] | generateToDhallInstance ] + [ fromDhallInstance name interpretOptions | generateFromDhallInstance ] <> + [ toDhallInstance name interpretOptions | generateToDhallInstance ] _ -> do let document = @@ -262,30 +265,33 @@ toDeclaration generateOptions@GenerateOptions{..} haskellTypes MultipleConstruct let message = Pretty.renderString (Dhall.Pretty.layout document) fail message -toDeclaration GenerateOptions{..} haskellTypes SingleConstructor{..} = do +toDeclaration generateOptions@GenerateOptions{..} haskellTypes typ@SingleConstructor{..} = do let name = Syntax.mkName (Text.unpack typeName) let derivingClauses = [ derivingGenericClause | generateFromDhallInstance || generateToDhallInstance ] - constructor <- toConstructor haskellTypes typeName (constructorName, Just code) + let interpretOptions = generateToInterpretOptions generateOptions typ + + constructor <- toConstructor generateOptions haskellTypes typeName (constructorName, Just code) fmap concat . sequence $ [pure [DataD [] name [] Nothing [constructor] derivingClauses]] <> - [ fromDhallInstance name [|Dhall.defaultInterpretOptions|] | generateFromDhallInstance ] <> - [ toDhallInstance name [|Dhall.defaultInterpretOptions|] | generateToDhallInstance ] + [ fromDhallInstance name interpretOptions | generateFromDhallInstance ] <> + [ toDhallInstance name interpretOptions | generateToDhallInstance ] -- | Convert a Dhall type to the corresponding Haskell constructor toConstructor :: (Eq a, Pretty a) - => [HaskellType (Expr s a)] + => GenerateOptions + -> [HaskellType (Expr s a)] -> Text -- ^ typeName -> (Text, Maybe (Expr s a)) -- ^ @(constructorName, fieldType)@ -> Q Con -toConstructor haskellTypes outerTypeName (constructorName, maybeAlternativeType) = do - let name = Syntax.mkName (Text.unpack constructorName) +toConstructor GenerateOptions{..} haskellTypes outerTypeName (constructorName, maybeAlternativeType) = do + let name = Syntax.mkName (Text.unpack $ constructorModifier constructorName) let bang = Bang NoSourceUnpackedness NoSourceStrictness @@ -371,8 +377,12 @@ data HaskellType code -- how Haskell code is generated. In particular you can -- -- * disable the generation of `FromDhall`/`ToDhall` instances. +-- * modify how a Dhall union field translates to a Haskell data constructor. data GenerateOptions = GenerateOptions - { generateFromDhallInstance :: Bool + { constructorModifier :: Text -> Text + -- ^ How to map a Dhall union field name to a Haskell constructor. + -- Note: The `constructorName` of `SingleConstructor` will be passed to this function, too. + , generateFromDhallInstance :: Bool -- ^ Generate a `FromDhall` instance for the Haskell type , generateToDhallInstance :: Bool -- ^ Generate a `ToDhall` instance for the Haskell type @@ -381,12 +391,46 @@ data GenerateOptions = GenerateOptions -- | A default set of options used by `makeHaskellTypes`. defaultGenerateOptions :: GenerateOptions defaultGenerateOptions = GenerateOptions - { generateFromDhallInstance = True + { constructorModifier = id + , generateFromDhallInstance = True , generateToDhallInstance = False } +generateToInterpretOptions :: GenerateOptions -> HaskellType (Expr s a) -> Q Exp +generateToInterpretOptions GenerateOptions{..} haskellType = [| Dhall.InterpretOptions + { Dhall.fieldModifier = Dhall.fieldModifier Dhall.defaultInterpretOptions + , Dhall.constructorModifier = \ $(nameP) -> $(toCases constructorModifier $ constructors haskellType) + , Dhall.singletonConstructors = Dhall.singletonConstructors Dhall.defaultInterpretOptions + }|] + where + constructors SingleConstructor{..} = [constructorName] + constructors MultipleConstructors{..} = case code of + Union kts -> Dhall.Map.keys kts + _ -> [] + + toCases :: (Text -> Text) -> [Text] -> Q Exp + toCases f = foldr mkCase [| error $ "SHOULD NEVER HAPPEN: Unmatched " <> show $(nameE) |] + where + mkCase n cont = [| + case $(nameE) of + $(textToQPat $ f n) -> $(textToQExp n) + _ -> $(cont) + |] + + nameE :: Q Exp + nameE = pure $ Syntax.VarE $ Syntax.mkName "n" + + nameP :: Q Pat + nameP = pure $ Syntax.VarP $ Syntax.mkName "n" + + textToQExp :: Text -> Q Exp + textToQExp = pure . Syntax.LitE . Syntax.StringL . Text.unpack + + textToQPat :: Text -> Q Pat + textToQPat = pure . Syntax.LitP . Syntax.StringL . Text.unpack + -- | Generate a Haskell datatype declaration with one constructor from a Dhall --- type +-- type. -- -- This comes in handy if you need to keep Dhall types and Haskell types in -- sync. You make the Dhall types the source of truth and use Template Haskell From f76db3372e84d159c77c1dc74363bf86d511993d Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Wed, 8 Sep 2021 02:10:57 +0200 Subject: [PATCH 06/12] Implementend `fieldModifier` This function controls how a Dhall record field is mapped to a Haskell record field. --- dhall/src/Dhall/TH.hs | 54 +++++++++++++++++++++++++++---------------- 1 file changed, 34 insertions(+), 20 deletions(-) diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs index bc0d7d191..ba482364e 100644 --- a/dhall/src/Dhall/TH.hs +++ b/dhall/src/Dhall/TH.hs @@ -27,10 +27,12 @@ import Prettyprinter (Pretty) import Language.Haskell.TH.Syntax ( Bang (..) + , Body (..) , Con (..) , Dec (..) , Exp (..) - , Pat + , Match (..) + , Pat (..) , Q , SourceStrictness (..) , SourceUnpackedness (..) @@ -40,6 +42,7 @@ import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax (DerivClause (..), DerivStrategy (..)) import qualified Data.List as List +import qualified Data.Set as Set import qualified Data.Text as Text import qualified Data.Typeable as Typeable import qualified Dhall @@ -382,6 +385,8 @@ data GenerateOptions = GenerateOptions { constructorModifier :: Text -> Text -- ^ How to map a Dhall union field name to a Haskell constructor. -- Note: The `constructorName` of `SingleConstructor` will be passed to this function, too. + , fieldModifier :: Text -> Text + -- ^ How to map a Dhall record field names to a Haskell record field names. , generateFromDhallInstance :: Bool -- ^ Generate a `FromDhall` instance for the Haskell type , generateToDhallInstance :: Bool @@ -392,42 +397,51 @@ data GenerateOptions = GenerateOptions defaultGenerateOptions :: GenerateOptions defaultGenerateOptions = GenerateOptions { constructorModifier = id + , fieldModifier = id , generateFromDhallInstance = True , generateToDhallInstance = False } generateToInterpretOptions :: GenerateOptions -> HaskellType (Expr s a) -> Q Exp generateToInterpretOptions GenerateOptions{..} haskellType = [| Dhall.InterpretOptions - { Dhall.fieldModifier = Dhall.fieldModifier Dhall.defaultInterpretOptions - , Dhall.constructorModifier = \ $(nameP) -> $(toCases constructorModifier $ constructors haskellType) + { Dhall.fieldModifier = \ $(pure nameP) -> + $(toCases fieldModifier $ fields haskellType) + , Dhall.constructorModifier = \ $(pure nameP) -> + $(toCases constructorModifier $ constructors haskellType) , Dhall.singletonConstructors = Dhall.singletonConstructors Dhall.defaultInterpretOptions }|] where + constructors :: HaskellType (Expr s a) -> [Text] constructors SingleConstructor{..} = [constructorName] - constructors MultipleConstructors{..} = case code of - Union kts -> Dhall.Map.keys kts - _ -> [] + constructors MultipleConstructors{..} | Union kts <- code = Dhall.Map.keys kts + constructors _ = [] + + fields :: HaskellType (Expr s a) -> [Text] + fields SingleConstructor{..} | Record kts <- code = Dhall.Map.keys kts + fields MultipleConstructors{..} | Union kts <- code = Set.toList $ mconcat + [ Dhall.Map.keysSet kts' + | (_, Just (Record kts')) <- Dhall.Map.toList kts + ] + fields _ = [] toCases :: (Text -> Text) -> [Text] -> Q Exp - toCases f = foldr mkCase [| error $ "SHOULD NEVER HAPPEN: Unmatched " <> show $(nameE) |] + toCases f xs = do + err <- [| error $ "SHOULD NEVER HAPPEN: Unmatched " <> show $(pure nameE) |] + pure $ CaseE nameE $ map mkMatch xs <> [Match WildP (NormalB err) []] where - mkCase n cont = [| - case $(nameE) of - $(textToQPat $ f n) -> $(textToQExp n) - _ -> $(cont) - |] + mkMatch n = Match (textToPat $ f n) (NormalB $ textToExp n) [] - nameE :: Q Exp - nameE = pure $ Syntax.VarE $ Syntax.mkName "n" + nameE :: Exp + nameE = Syntax.VarE $ Syntax.mkName "n" - nameP :: Q Pat - nameP = pure $ Syntax.VarP $ Syntax.mkName "n" + nameP :: Pat + nameP = Syntax.VarP $ Syntax.mkName "n" - textToQExp :: Text -> Q Exp - textToQExp = pure . Syntax.LitE . Syntax.StringL . Text.unpack + textToExp :: Text -> Exp + textToExp = Syntax.LitE . Syntax.StringL . Text.unpack - textToQPat :: Text -> Q Pat - textToQPat = pure . Syntax.LitP . Syntax.StringL . Text.unpack + textToPat :: Text -> Pat + textToPat = Syntax.LitP . Syntax.StringL . Text.unpack -- | Generate a Haskell datatype declaration with one constructor from a Dhall -- type. From 1fb5aff6c06060c5a84c5cf1f3c0a0d08e2aee66 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Fri, 10 Sep 2021 19:01:02 +0200 Subject: [PATCH 07/12] Fixed: `fieldModifier` in nested types and `defaultGenerateOptions` --- dhall/src/Dhall/TH.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs index ba482364e..89957e8e4 100644 --- a/dhall/src/Dhall/TH.hs +++ b/dhall/src/Dhall/TH.hs @@ -313,7 +313,7 @@ toConstructor GenerateOptions{..} haskellTypes outerTypeName (constructorName, m let process (key, dhallFieldType) = do haskellFieldType <- toNestedHaskellType haskellTypes dhallFieldType - return (Syntax.mkName (Text.unpack key), bang, haskellFieldType) + return (Syntax.mkName (Text.unpack $ fieldModifier key), bang, haskellFieldType) varBangTypes <- traverse process (Dhall.Map.toList $ Core.recordFieldValue <$> kts) @@ -399,7 +399,7 @@ defaultGenerateOptions = GenerateOptions { constructorModifier = id , fieldModifier = id , generateFromDhallInstance = True - , generateToDhallInstance = False + , generateToDhallInstance = True } generateToInterpretOptions :: GenerateOptions -> HaskellType (Expr s a) -> Q Exp From e9e8b2e5e6fd6e49c3e97feceed478d252354378 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Fri, 10 Sep 2021 19:02:45 +0200 Subject: [PATCH 08/12] Added tests for `makeHaskellTypesWith` --- dhall/tests/Dhall/Test/TH.hs | 83 ++++++++++++++++++++++++++++++++++++ 1 file changed, 83 insertions(+) diff --git a/dhall/tests/Dhall/Test/TH.hs b/dhall/tests/Dhall/Test/TH.hs index 7ef45d621..0824a6bfc 100644 --- a/dhall/tests/Dhall/Test/TH.hs +++ b/dhall/tests/Dhall/Test/TH.hs @@ -7,9 +7,12 @@ module Dhall.Test.TH where +import Control.Exception (throwIO) +import Data.Either.Validation (Validation(..)) import Dhall.TH (HaskellType (..)) import Test.Tasty (TestTree) +import qualified Data.Text import qualified Dhall import qualified Dhall.TH import qualified Test.Tasty as Tasty @@ -70,3 +73,83 @@ makeHaskellTypeFromUnion = Tasty.HUnit.testCase "makeHaskellTypeFromUnion" $ do qux <- Dhall.input Dhall.auto "let T = ./tests/th/issue2066.dhall in T.Qux.Foo { foo = +2, bar = { baz = +3 } }" Tasty.HUnit.assertEqual "" qux (Foo MakeFoo{ foo = 2, bar = MakeBar{ baz = 3 } }) + +Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions + { Dhall.TH.constructorModifier = ("My" <>) + , Dhall.TH.fieldModifier = ("my" <>) . Data.Text.toTitle + }) + [ MultipleConstructors "MyT" "./tests/th/example.dhall" + , MultipleConstructors "MyDepartment" "./tests/th/Department.dhall" + , SingleConstructor "MyEmployee" "Employee" "./tests/th/Employee.dhall" + ] + +deriving instance Eq MyT +deriving instance Eq MyDepartment +deriving instance Eq MyEmployee +deriving instance Show MyT +deriving instance Show MyDepartment +deriving instance Show MyEmployee + +testMakeHaskellTypesWith :: TestTree +testMakeHaskellTypesWith = Tasty.HUnit.testCase "makeHaskellTypesWith" $ do + let text0 = "let T = ./tests/th/example.dhall in T.A { x = True, y = [] : List Text }" + ref0 = MyA{ myX = True, myY = [] } + myTest text0 ref0 + + let text1 = "let T = ./tests/th/example.dhall in T.B (None (List Natural))" + ref1 = MyB Nothing + myTest text1 ref1 + + let text2 = "let T = ./tests/th/example.dhall in T.C" + ref2 = MyC + myTest text2 ref2 + + let textDepartment = "let T = ./tests/th/Department.dhall in T.Sales" + refDepartment = MySales + myTest textDepartment refDepartment + + let textEmployee = "let T = ./tests/th/Department.dhall in T.Sales" + refEmployee = MyEmployee{ myName = "", myDepartment = MySales } + myTest textEmployee refEmployee + where + myTest text ref = do + expr <- Dhall.inputExpr text + t <- case Dhall.extract Dhall.auto expr of + Failure e -> throwIO e + Success t -> return t + + Tasty.HUnit.assertEqual "" t ref + Tasty.HUnit.assertEqual "" expr $ Dhall.embed Dhall.inject ref + +Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions + { Dhall.TH.constructorModifier = ("NoFromDhall" <>) + , Dhall.TH.fieldModifier = ("noFromDhall" <>) . Data.Text.toTitle + , Dhall.TH.generateFromDhallInstance = False + }) + [ MultipleConstructors "NoFromDhallT" "./tests/th/example.dhall" + ] + +instance Dhall.FromDhall NoFromDhallT + +Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions + { Dhall.TH.constructorModifier = ("NoToDhall" <>) + , Dhall.TH.fieldModifier = ("noToDhall" <>) . Data.Text.toTitle + , Dhall.TH.generateToDhallInstance = False + }) + [ MultipleConstructors "NoToDhallT" "./tests/th/example.dhall" + ] + +instance Dhall.ToDhall NoToDhallT + +Dhall.TH.makeHaskellTypesWith (Dhall.TH.defaultGenerateOptions + { Dhall.TH.constructorModifier = ("NoInstances" <>) + , Dhall.TH.fieldModifier = ("noInstances" <>) . Data.Text.toTitle + , Dhall.TH.generateFromDhallInstance = False + , Dhall.TH.generateToDhallInstance = False + }) + [ MultipleConstructors "NoInstancesT" "./tests/th/example.dhall" + ] + +deriving instance Dhall.Generic NoInstancesT +instance Dhall.FromDhall NoInstancesT +instance Dhall.ToDhall NoInstancesT From 43f603eab21260c8e7972cfb33f0d88f1bb47155 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Fri, 10 Sep 2021 19:25:01 +0200 Subject: [PATCH 09/12] Improved documentation --- dhall/src/Dhall/TH.hs | 28 ++++++++++++++++++++++------ 1 file changed, 22 insertions(+), 6 deletions(-) diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs index 89957e8e4..9b006aa6f 100644 --- a/dhall/src/Dhall/TH.hs +++ b/dhall/src/Dhall/TH.hs @@ -187,16 +187,25 @@ toNestedHaskellType haskellTypes = loop predicate haskellType = Core.judgmentallyEqual (code haskellType) dhallType +-- | A deriving clause for `Generic`. derivingGenericClause :: DerivClause derivingGenericClause = DerivClause (Just StockStrategy) [ ConT ''Generic ] -fromDhallInstance :: Syntax.Name -> Q Exp -> Q [Dec] +-- | Generates a `FromDhall` instances. +fromDhallInstance + :: Syntax.Name -- ^ The name of the type the instances is for + -> Q Exp -- ^ A TH splice generating some `InterpretOptions` + -> Q [Dec] fromDhallInstance n interpretOptions = [d| instance FromDhall $(pure $ ConT n) where autoWith = Dhall.genericAutoWithInputNormalizer $(interpretOptions) |] -toDhallInstance :: Syntax.Name -> Q Exp -> Q [Dec] +-- | Generates a `ToDhall` instances. +toDhallInstance + :: Syntax.Name -- ^ The name of the type the instances is for + -> Q Exp -- ^ A TH splice generating some `InterpretOptions` + -> Q [Dec] toDhallInstance n interpretOptions = [d| instance ToDhall $(pure $ ConT n) where injectWith = Dhall.genericToDhallWithInputNormalizer $(interpretOptions) @@ -352,17 +361,17 @@ makeHaskellTypeFromUnion typeName code = makeHaskellTypes [ MultipleConstructors{..} ] -- | Used by `makeHaskellTypes` and `makeHaskellTypesWith` to specify how to --- generate Haskell types +-- generate Haskell types. data HaskellType code -- | Generate a Haskell type with more than one constructor from a Dhall - -- union type + -- union type. = MultipleConstructors { typeName :: Text -- ^ Name of the generated Haskell type , code :: code -- ^ Dhall code that evaluates to a union type } - -- | Generate a Haskell type with one constructor from any Dhall type + -- | Generate a Haskell type with one constructor from any Dhall type. -- -- To generate a constructor with multiple named fields, supply a Dhall -- record type. This does not support more than one anonymous field. @@ -393,7 +402,10 @@ data GenerateOptions = GenerateOptions -- ^ Generate a `ToDhall` instance for the Haskell type } --- | A default set of options used by `makeHaskellTypes`. +-- | A default set of options used by `makeHaskellTypes`. That means: +-- +-- * Constructors and fields are passed unmodified. +-- * Both `FromDhall` and `ToDhall` instances are generated. defaultGenerateOptions :: GenerateOptions defaultGenerateOptions = GenerateOptions { constructorModifier = id @@ -402,6 +414,10 @@ defaultGenerateOptions = GenerateOptions , generateToDhallInstance = True } +-- | This function generates `Dhall.InterpretOptions` that can be used for the +-- marshalling of the Haskell type generated according to the `GenerateOptions`. +-- I.e. those `InterpretOptions` reflect the mapping done by `constructorModifier` +-- and `fieldModifier` on the value level. generateToInterpretOptions :: GenerateOptions -> HaskellType (Expr s a) -> Q Exp generateToInterpretOptions GenerateOptions{..} haskellType = [| Dhall.InterpretOptions { Dhall.fieldModifier = \ $(pure nameP) -> From ad7551ad95e5e24a60be64dc897be5596fab9e31 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Fri, 10 Sep 2021 20:10:19 +0200 Subject: [PATCH 10/12] Fixed: Reference to `InterpretOptions` in documentation --- dhall/src/Dhall/TH.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs index 9b006aa6f..9b09f7506 100644 --- a/dhall/src/Dhall/TH.hs +++ b/dhall/src/Dhall/TH.hs @@ -194,7 +194,7 @@ derivingGenericClause = DerivClause (Just StockStrategy) [ ConT ''Generic ] -- | Generates a `FromDhall` instances. fromDhallInstance :: Syntax.Name -- ^ The name of the type the instances is for - -> Q Exp -- ^ A TH splice generating some `InterpretOptions` + -> Q Exp -- ^ A TH splice generating some `Dhall.InterpretOptions` -> Q [Dec] fromDhallInstance n interpretOptions = [d| instance FromDhall $(pure $ ConT n) where @@ -204,7 +204,7 @@ fromDhallInstance n interpretOptions = [d| -- | Generates a `ToDhall` instances. toDhallInstance :: Syntax.Name -- ^ The name of the type the instances is for - -> Q Exp -- ^ A TH splice generating some `InterpretOptions` + -> Q Exp -- ^ A TH splice generating some `Dhall.InterpretOptions` -> Q [Dec] toDhallInstance n interpretOptions = [d| instance ToDhall $(pure $ ConT n) where @@ -416,8 +416,8 @@ defaultGenerateOptions = GenerateOptions -- | This function generates `Dhall.InterpretOptions` that can be used for the -- marshalling of the Haskell type generated according to the `GenerateOptions`. --- I.e. those `InterpretOptions` reflect the mapping done by `constructorModifier` --- and `fieldModifier` on the value level. +-- I.e. those `Dhall.InterpretOptions` reflect the mapping done by +-- `constructorModifier` and `fieldModifier` on the value level. generateToInterpretOptions :: GenerateOptions -> HaskellType (Expr s a) -> Q Exp generateToInterpretOptions GenerateOptions{..} haskellType = [| Dhall.InterpretOptions { Dhall.fieldModifier = \ $(pure nameP) -> From e1839e9a4d1f5077e2901cf1d33049e99dab890a Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Sun, 12 Sep 2021 12:50:26 +0200 Subject: [PATCH 11/12] Use `Dhall.Core.internalError` instead of error --- dhall/src/Dhall/TH.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs index 9b09f7506..7aef82571 100644 --- a/dhall/src/Dhall/TH.hs +++ b/dhall/src/Dhall/TH.hs @@ -442,7 +442,7 @@ generateToInterpretOptions GenerateOptions{..} haskellType = [| Dhall.InterpretO toCases :: (Text -> Text) -> [Text] -> Q Exp toCases f xs = do - err <- [| error $ "SHOULD NEVER HAPPEN: Unmatched " <> show $(pure nameE) |] + err <- [| Core.internalError $ "Unmatched " <> show $(pure nameE) |] pure $ CaseE nameE $ map mkMatch xs <> [Match WildP (NormalB err) []] where mkMatch n = Match (textToPat $ f n) (NormalB $ textToExp n) [] From 3b3757ce2078f769ca0c86e4ccab621acfe05212 Mon Sep 17 00:00:00 2001 From: Mann mit Hut Date: Sun, 12 Sep 2021 21:07:24 +0200 Subject: [PATCH 12/12] Fixed: Call to `Dhall.Core.internalError` expects Text not String --- dhall/src/Dhall/TH.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dhall/src/Dhall/TH.hs b/dhall/src/Dhall/TH.hs index 7aef82571..cd265d9b1 100644 --- a/dhall/src/Dhall/TH.hs +++ b/dhall/src/Dhall/TH.hs @@ -442,7 +442,7 @@ generateToInterpretOptions GenerateOptions{..} haskellType = [| Dhall.InterpretO toCases :: (Text -> Text) -> [Text] -> Q Exp toCases f xs = do - err <- [| Core.internalError $ "Unmatched " <> show $(pure nameE) |] + err <- [| Core.internalError $ "Unmatched " <> Text.pack (show $(pure nameE)) |] pure $ CaseE nameE $ map mkMatch xs <> [Match WildP (NormalB err) []] where mkMatch n = Match (textToPat $ f n) (NormalB $ textToExp n) []