如何在Template Haskell函数中使用Name列表?

时间:2017-02-05 17:52:07

标签: haskell template-haskell

我想参数化模板,以便用户可以给出列表Name的定义方法。

以下示例尝试最小化。有一个data D1包含事先未知的字段(到模板)。用户希望派生使用某些字段的实例,因此,用户必须在声明数据结构时告知它。数据结构是相似的,我们想要为它们派生实例:但是,字段的数量可以变化。

{-# LANGUAGE TemplateHaskell #-}

module Main where

import Language.Haskell.TH
import Data.List (intercalate)

data D1 = D1 
  { f1 :: Int
  , f2 :: String
  , f3 :: Double
  } deriving (Show, Eq)

class Show2 a where
  show2 :: a -> String

{-
instance Show2 D1 where
  show2 d1 = "1: " ++ show (f1 d1) ++ " and 2: " ++ show (f3 d1)
 -}

tpl1 :: Name -> Q [Dec]
tpl1 nm = 
  [d|
    instance Show2 $(conT nm) where
      show2 d1 = "1: " ++ show (f1 d1) ++ " and 2: " ++ show (f3 d1)
   |]


tpl2 :: Name -> [Name] -> Q [Dec]
tpl2 nm fnms = do
  -- let showName d n = show $(varE n) d  -- stage restriction
  -- let showGo1 d n = [| show $(showName n) d |]  -- stage error 
  -- UPDATED based on a given hint:
  let nmFs = return $ ListE (map VarE fnms) :: Q Exp -- compiles, but [Int, Double] is a problem
      valF f d = AppE (VarE f) (VarE d) :: Exp
      anmFs2 f d = return $ AppE (VarE 'GHC.Show.show) (valF f d ) :: Q Exp -- compiles and works with head
      anmFs3 d f = AppE (VarE 'GHC.Show.show) (valF f d ) :: Exp 
      lstF d = return $ ListE (map (anmFs3 d) fnms)  :: Q Exp -- UPDATE ends
  [d|
    instance Show2 $(conT nm) where
      -- UPDATED based on a given hint:
      show2 d = intercalate ", " $(lstF 'd) 
      -- show2 d = $(anmFs2 (head fnms) 'd) -- compiles and works, but only head here
      -- show2 d = intercalate ", " (map (\n -> show ( n d ) ) $(nmFs) ) -- compiles, [Int, Double] is a problem
      -- UPDATE ends
      -- show2 d = intercalate ", " (map (\n -> show ( $(varE n) d) ) fnms )     -- stage error
      -- show2 d = intercalate ", " (map ( $(showName d) ) fnms ) -- showName in brackets in other module -> stage error
      -- show2 d = intercalate ", " (map ( $(showGo1 d) ) fnms ) -- showName in brackets in other module -> stage error
   |]

-- wishing to use, after data decl D1, like 
-- $(tpl2 ''D1 ['f1, 'f3])

main = do
 let d = D1 1 "hmm" 2.0
 -- putStrLn $ show2 d
 putStrLn $ "hmm"

可以使用下面显示的实例或子句以及th-lib中给出的组合子来编写模板。然而,感觉有点乏味,通过使用接头和支架,它会更好。

那么,问题是当用户想要告诉字段时如何编写show2? (是使用低级设施的唯一选择吗?)

-- ghci:
-- pure []; $(tpl1 ''D1)
-- <interactive>:12:1-7: Splicing declarations pure [] ======>
-- <interactive>:12:12-20: Splicing declarations
--  tpl1 ''D1
--   ======>
--   instance Show2 D1 where
--     show2 d1_a5yR
--       = ("1: " ++ ((show (f1 d1_a5yR)) 
--       ++ (" and 2: " ++ (show (f3 d1_a5yR)))))
-- and
-- $(tpl1 ''D1 >>= stringE . show)
-- gives a representation mimickable with combinators. 
-- [InstanceD Nothing [] (AppT (ConT Main.Show2) (ConT Main.D1)) 
-- [FunD
--   Main.show2 
--     [Clause [VarP d1_6989586621679033595] 
--      (NormalB (InfixE (Just (LitE (StringL \"1: \"))) (VarE     GHC.Base.++) 
--       (Just (InfixE (Just (AppE (VarE GHC.Show.show) 
--        (AppE (VarE Main.f1) (VarE d1_6989586621679033595)))) (VarE
--        GHC.Base.++) (Just (InfixE (Just (LitE (StringL \" and 2: \"))) (VarE
--        GHC.Base.++) (Just (AppE (VarE GHC.Show.show) (AppE (VarE     Main.f3) (VarE
--        d1_6989586621679033595)))))))
--       ))
--      ) 
--      []
--     ]
-- ]
-- ]
--

0 个答案:

没有答案