haskell - 如何在 Haskell 中编写一系列 printf 函数(调试打印等)

Question

这是一个挑战问题，而不是一个有用的问题(我花了几个小时在上面)。给定一些函数，

put_debug, put_err :: String -> IO ()
put_foo :: String -> StateT [String] m ()

我想写一个通用的printf函数，叫它gprint，这样我就可以写了

pdebug = gprint put_debug
perr = gprint put_err
pfoo = gprint put_foo

然后使用 pdebug , perr , 和 pfoo喜欢 printf ， 例如，

pdebug "Hi"
pdebug "my value: %d" 1
pdebug "two values: %d, %d" 1 2

我无法提出一个足够通用的类(class)。我的尝试是这样的(对于那些熟悉 Printf 或 Oleg 的可变参数函数方法的人)

class PrintfTyp r where
    type AppendArg r a :: *
    spr :: (String -> a) -> String -> [UPrintf] -> AppendArg r a

或者

class PrintfTyp r where
    type KRetTyp r :: *
    spr :: (String -> KRetTyp r) -> String -> [UPrintf] -> r

两者都很难编写基本实例: r 没有好的选择对于第一种方法(并且，它的类型没有反射(reflect)在非单射索引类型族 AppendArg 中)，而在第二种方法中，最后写成 instance PrintfTyp a看起来不对(匹配太多类型)。

同样，这只是一个挑战问题:只有当它有趣时才去做。不过，我肯定很想知道答案。谢谢!!

Answer 1

这是一种尝试让现有 Text.Printf做尽可能多的工作。首先，我们需要一些扩展:

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

-- To avoid having to write some type signatures.
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ExtendedDefaultRules #-}

import Control.Monad.State
import Text.Printf

这个想法是一次将一个参数输入 printf获取格式化 String ，然后将其用于我们在开始时给出的操作。

gprint :: GPrintType a => (String -> EndResult a) -> String -> a
gprint f s = gprint' f (printf s)

class PrintfType (Printf a) => GPrintType a where
  type Printf a :: *
  type EndResult a :: *
  gprint' :: (String -> EndResult a) -> Printf a -> a

递归步骤接受一个参数，并将其提供给 printf调用我们正在建立 g .

instance (PrintfArg a, GPrintType b) => GPrintType (a -> b) where
  type Printf (a -> b) = a -> Printf b
  type EndResult (a -> b) = EndResult b
  gprint' f g x = gprint' f (g x)

基本情况只是将结果字符串输入 f :

instance GPrintType (IO a) where
  type Printf (IO a) = String
  type EndResult (IO a) = IO a
  gprint' f x = f x

instance GPrintType (StateT s m a) where
  type Printf (StateT s m a) = String
  type EndResult (StateT s m a) = StateT s m a
  gprint' f x = f x

这是我使用的测试程序:

put_debug, put_err :: String -> IO ()
put_foo :: Monad m => String -> StateT [String] m ()

put_debug = putStrLn . ("DEBUG: " ++)
put_err   = putStrLn . ("ERR: " ++)
put_foo x = modify (++ [x])

pdebug = gprint put_debug
perr = gprint put_err
pfoo = gprint put_foo

main = do
  pdebug "Hi"
  pdebug "my value: %d" 1
  pdebug "two values: %d, %d" 1 2
  perr "ouch"
  execStateT (pfoo "one value: %d" 42) [] >>= print

和输出:

DEBUG: Hi
DEBUG: my value: 1
DEBUG: two values: 1, 2
ERR: ouch
["one value: 42"]