Funkcja Haskell, która przyjmuje funkcję wariancji jako argument (i zwraca coś innego niż funkcja func) bez FlexibleInstances, pure Haskell2010

Question

jest możliwe wyrażenie następującego programu Haskell bez FlexibleInstances, tj. W czystym Haskell2010?

{-# 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)] 

Inspiracją dla tej odpowiedzi jest How to write a Haskell function that takes a variadic function as an argument.

Podejrzewam, że problem polega na tym, że truth zwraca coś innego niż funkcję, którą przyjmuje jako argument (który zwraca Bool, a nie [Bool]).

Celem tego fragmentu jest, aby dać listę wszystkich ocen ze wszystkich możliwych konfiguracji dla logicznej funkcji, tzn

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

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

w końcu, prawda-tabela ma zostać wydrukowany, jak to (patrz boiler-talerz na końcu tego postu, aby zobaczyć kod, który wywołuje to):

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 

Oto kod kotła płyta do testowania i wizualizacji, co jest celem tej funkcji jest:

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

Nie ma problemu:

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 

Można nawet zrobić 'wartości logicznych honorowych', jeśli chcesz, jak Integer z 0 i 1 itd

Answer 2

Haskell98 sposobem jest użycie newtypes dla ([] Bool) i ((->) 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)] 

Tę część następnie zestawia bez potrzeby dokonywania rozszerzeń języka. Ale eliminuje przypadek użycia, który sprawia, że ​​"prawda" staje się prosta w obsłudze.