Función Haskell que toma una función variada como argumento (y devuelve algo más que ese func) sin FlexibleInstances, puro Haskell2010

Question

¿es posible expresar el siguiente programa Haskell sin FlexibleInstances, es decir, en Haskell2010 puro?

{-# LANGUAGE FlexibleInstances #-} 

class Funk a  where truth :: a -> [Bool] 
instance Funk [Bool] where truth = \x -> x 
instance Funk Bool where truth = \x -> [x] 

instance Funk b => Funk (Bool -> b) where 
    truth f = concat [truth (f True), truth (f False)] 

Esto se inspira en la respuesta en How to write a Haskell function that takes a variadic function as an argument.

Sospecho que el problema es que truth devuelve algo más que la función que toma como argumento (que devuelve Bool, no [Bool]).

El propósito de este fragmento se, para dar una lista de todas las evaluaciones de toda la configuración posible para una función booleana, es decir

Main> truth (\x y -> x && y) 
[True,False,False,False] 

Main> truth (\x y -> x || y) 
[True,True,True,False] 

Al final, una tabla de verdad se va a imprimir, como este (ver caldera-placa al final de este post para ver el código que produce este):

Main> main 
T T T | T 
T T F | T 
T F T | T 
T F F | F 
F T T | T 
F T F | F 
F F T | T 
F F F | T 

Aquí hay un código caldera-placa para la prueba y visualizar, cuál es el propósito de esta función es:

class TruthTable a where 
    truthTable :: Funk f => f -> a 

instance TruthTable [String] where 
    truthTable f = zipWith (++) (hCells (div (length t) 2)) (map showBool $ truth f) 
     where 
      showBool True = "| T" 
      showBool False = "| F" 
      hCells 1 = ["T ", "F "] 
      hCells n = ["T " ++ x | x <- hCells (div n 2)] ++ ["F " ++ x | x <- hCells (div n 2)] 

instance TruthTable [Char] where 
    truthTable f = foldl1 join (truthTable f) 
     where join a b = a ++ "\n" ++ b 

instance TruthTable (IO a) where 
    truthTable f = putStrLn (truthTable f) >> return undefined 

main :: IO() 
main = truthTable (\x y z -> x `xor` y ==> z) 

xor :: Bool -> Bool -> Bool 
xor a b = not $ a == b 

(==>) :: Bool -> Bool -> Bool 
a ==> b = not $ a && not b 

Answer 1

No hay problema:

class Funk a     where truth :: a -> [Bool] 
instance (IsBool a) => Funk [a] where truth = map toBool 
instance Funk Bool    where truth = \x -> [x] 

instance (IsBool a, Funk b) => Funk (a -> b) where 
    truth f = concat [truth (f $ fromBool True), truth (f $ fromBool False)] 

class IsBool a where 
    toBool :: a -> Bool 
    fromBool :: Bool -> a 

instance IsBool Bool where 
    toBool = id 
    fromBool = id 

Usted puede incluso hacer 'booleanos honorarios' si lo desea, como enteros con 0 y 1, etc.

Answer 2

manera El Haskell98 es utilizar Newtypes para ([] Bool) y ((->) Bool b):

newtype LB = LB [Bool] 
newtype FAB b = FAB (Bool -> b) 

class Funk a  where truth :: a -> [Bool] 
instance Funk LB  where truth = \(LB x) -> x 
instance Funk Bool where truth = \x -> [x] 

instance Funk b => Funk (FAB b) where 
    truth (FAB f) = concat [truth (f True), truth (f False)] 

Esta parte entonces se compila sin necesarios ningún extensiones de lenguaje. Pero elimina el caso de uso de hacer que la 'verdad' sea simple de trabajar.