Cómo escribir una familia de funciones de impresión (impresión de depuración, etc.) en Haskell

Question

Este es un problema de desafío más que un problema útil (he pasado unas horas en él). Teniendo en cuenta que algunas funciones,

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

Quiero escribir una función printf generalizada, lo llaman GPRINT, de modo que puedo escribir

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

y luego usar pdebug, perr y pfoo como printf, por ejemplo, ,

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

No puedo lograr una clase suficientemente general. Mis intentos han sido cosas como (para quienes están familiarizados con Printf, o enfoque de la función variadic de Oleg)

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

o

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

Ambos son demasiado difíciles de escribir instancias de base para: no hay una buena opción para r para el primer enfoque (y su tipo no se refleja en la familia AppendArg del tipo indexado no inyectado), y en el segundo enfoque, uno termina escribiendo instance PrintfTyp a que parece incorrecto (coincide con demasiados tipos).

De nuevo, es solo un problema: hazlo solo si es divertido. Sin embargo, definitivamente tendría curiosidad por saber la respuesta. ¡¡Gracias!!

Answer 1

Aquí es un enfoque que trata de dejar que el Text.Printf existente para hacer la mayor cantidad de trabajo posible.En primer lugar, vamos a necesitar algunas extensiones:

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

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

import Control.Monad.State 
import Text.Printf 

La idea es alimentar a los argumentos de uno en uno en printfString para obtener el formato, a continuación, tomar eso y darle a la acción nos dieron en el comienzo.

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 

El paso recursivo toma un argumento, y la inyecta a la llamada printf que estamos construyendo en 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) 

Los casos base simplemente alimentan la cadena resultante en 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 

Aquí está el programa de pruebas he utilizado:

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 

Y la salida:

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

Answer 2

No estoy seguro de que el compilador pueda deducir esto. ¿Cómo sabe que espera que la secuencia se imprima en el contexto de una mónada StateT, en lugar de tomar otro argumento en la mónada (a ->)?

Probablemente necesite presentar una forma de mostrar el verificador de tipos cuando la lista de argumentos haya finalizado. La forma más sencilla es simplemente lo envuelve en una función, por lo que escribir:

pdebug $ printf "%d %d %d" 1 2 3 

Y luego pdebug podría ser polimórficos en la mónada.

Es posible que también sea capaz de pivotar por lo que utilizar un terminador, como:

data Kthx = Kthx 
printf "%d %d %d" 1 2 3 Kthx 

Pero no acabo de encontrar la manera en este momento.

Answer 3

Las clases son para envío basado en tipo. Por lo tanto, para put_foo, la arquitectura Text.Printf ya es satisfactoria (aunque lamentablemente no exporta PrintfType). Por ejemplo, la siguiente parece funcionar bien:

{-# LANGUAGE TypeFamilies #-} -- for ~ syntax 
import Control.Monad.State 
import Data.Default 

-- copy and paste source of Text.Printf here 

put_foo :: String -> StateT [String] m() 
put_foo = undefined 

instance (Default a, Monad m, s ~ [String]) => PrintfType (StateT s m a) where 
    spr s us = put_foo (spr s us) >> return def 

para put_debug y put_err, se puede generalizar el PrintfType de la misma manera HPrintfType hace, pero teniendo una función String -> IO() en lugar de un mango. De allí tendría que escribir

pdebug = funPrintf put_debug 
perr = funPrintf put_err 
printf' = funPrintf putStr -- just for fun 
pfoo = printf