Mapping su una struttura di dati eterogenea con una funzione generica

Question

Sto lavorando a un'implementazione di HList e sono bloccato cercando di implementare una funzione map per questo. Ho provato un sacco di approcci diversi, ma con ognuno ho raggiunto errori del compilatore relativi a quella funzione.

Di seguito è riportato un esempio di come si desidera utilizzare una funzione generica Just per applicarla a tutti gli elementi della struttura di dati di input.

{-# LANGUAGE MultiParamTypeClasses #-} 
{-# LANGUAGE FlexibleInstances #-} 

-- | An input heterogenous data structure 
recursivePairs :: (Int, (Char, (Bool,()))) 
recursivePairs = (1, ('a', (True,()))) 

-- | This is how I want to use it 
recursivePairs' :: (Maybe Int, (Maybe Char, (Maybe Bool,()))) 
recursivePairs' = hMap Just recursivePairs 

class HMap f input output where 
    hMap :: f -> input -> output 

-- | A counterpart of a Nil pattern match for a list 
instance HMap f()() where 
    hMap _ _ =() 

-- | A counterpart of a Cons pattern match for a list 
instance 
    (HMap f iTail oTail, 
    Apply f iHead oHead) => 
    HMap f (iHead, iTail) (oHead, oTail) 
    where 
    hMap f (head, tail) = (apply f head, hMap f tail) 

class Apply f input output where 
    apply :: f -> input -> output 

instance Apply (input -> output) input output where 
    apply = id 

Con questo sto ottenendo il seguente errore del compilatore:

No instance for (Apply (a0 -> Maybe a0) Int (Maybe Int)) 
    arising from a use of `hMap' 
The type variable `a0' is ambiguous 

C'è affatto un modo per risolvere questo e se non allora perché?

Answer 1

Il problema è che si sta tentando di utilizzare una funzione polimorfica con argomenti diversi, ma l'istanza Apply accetta una funzione (un tipo mono). Si può facilmente risolvere questo problema diversi modi

data JustIfy = JustIfy 
instance Apply JustIfy a (Maybe a) where 
    apply _ = Just 

recursivePairs' :: (Maybe Int, (Maybe Char, (Maybe Bool,()))) 
recursivePairs' = hMap JustIfy recursivePairs 

opere con il codice bene

EDIT: Un approccio più generale per la stessa cosa è (che richiede RankNTypes)

--A "universal" action that works on all types 
newtype Univ f = Univ (forall x. x -> f x) 
instance Apply (Univ f) x (f x) where 
    apply (Univ f) x = f x 

recursivePairs' :: (Maybe Int, (Maybe Char, (Maybe Bool,()))) 
recursivePairs' = hMap (Univ Just) recursivePairs 

o se si è utilizzando una versione ish recente di GHC e sono disposti ad attivare più estensioni

newtype Univ' c f = Univ' (forall x. c x => x -> f x) 
instance c x => Apply (Univ' c f) x (f x) where 
    apply (Univ' f) x = f x 

class All x 
instance All x 

recursivePairs' :: (Maybe Int, (Maybe Char, (Maybe Bool,()))) 
recursivePairs' = hMap (Univ' Just :: Univ' All Maybe) recursivePairs 

che è bello da allora ti consente di fare cose come includere uno "spettacolo" nella funzione con cui stai mappando.

Per una soluzione più generale, consultare Oleg's Type level lambda caclulus che consente di scrivere codice a livello di valore e quindi auto magicamente deduce l'appropriato programma di livello di tipo. Sfortunatamente, la soluzione di Oleg è a questo punto piuttosto vecchia, e usa un'implementazione nominale della LC che non mi piace particolarmente. Stavo pensando a come fare meglio, ma potrei resistere fino a quando l'uguaglianza decisa arriva a digitare le famiglie.

La mia opinione è che HLists dovrebbe essere fatto in questi giorni usando GADT e DataKinds piuttosto che tuple. Le famiglie di tipi sono preferibili alle dipendenze funzionali, ma attualmente sono più limitate perché mancano di uguaglianza decidibile.

Answer 2

Anche se la seguente non esattamente rispondere alla domanda (in modo da non sarò accettarla), essa non risolve il problema riguardante la mappatura della struttura senza la necessità di ulteriori istanze per funtori applicative:

{-# LANGUAGE MultiParamTypeClasses #-} 
{-# LANGUAGE FlexibleInstances #-} 

import Control.Applicative 

main = do 
    print $ (hPure recursivePairs :: (Maybe Int, (Maybe Char, (Maybe Bool,())))) 
    print $ (hPure recursivePairs :: ([Int], ([Char], ([Bool],())))) 

recursivePairs :: (Int, (Char, (Bool,()))) 
recursivePairs = (1, ('a', (True,()))) 

class HPure input output where 
    hPure :: input -> output 

instance HPure()() where 
    hPure _ =() 

instance 
    (Applicative f, 
    HPure iTail oTail) => 
    HPure (iHead, iTail) (f iHead, oTail) 
    where hPure (iHead, iTail) = (pure iHead, hPure iTail) 

Uscite :

(Just 1,(Just 'a',(Just True,()))) 
([1],("a",([True],())))