Performing Art Gleichheit in Vorlage Haskell

Question

ich eine Funktion in Template Haskell haben, die die Typinformationen extrahiert für Summe von Rekord Konstrukteuren wie folgt:

listFields :: Name -> Q ([[(String,Name,Type)]]) 
listFields name = do 
    TyConI (DataD _ _ _ cons _) <- reify name 
    let showClause (RecC conName fields) = (map (\(x,_,t) -> (nameBase $ x,x,t)) fields) 
    return $ map showClause cons 

die Art dort für ein Feld gegeben, wie Sie im Vergleich Gleichheit dieser Typ mit einem bestimmten Typ wie GHC.Base.String oder Data.Text.Internal.Text? Ich sehe TypeQ in TH Dokumentation. Es baut Typausdruck auf. Ich kann jedoch keine Dokumentation darüber finden, wie ein bestimmter Typ wie String oder Text oder Int erstellt wird, damit ich ihn für den Vergleich der Gleichheit verwenden kann? Ich schätze Hinweise dazu, wie man das macht, insbesondere wie man den AST für einen bestimmten Typ bekommt.

Der Grund für diese Frage ist, dass gegebenen Datensatzkonstruktor wir jedes Feld in konvertieren möchten. show und pack sollten jedoch für die Typen String und Text unterschiedlich benannt werden. So, müssen Sie verschiedene Spleiße generieren, wenn der Typ (keine Konvertierung) oder String (nur Anruf pack, nicht show anrufen) oder etwas anderes (rufen Sie pack . show unter der Annahme Show Instanz existiert).

Answer 1

Als eine Folge zu der anderen Antwort, hier ist etwas, mit dem Sie ToText ohne überlappende Instanzen schreiben können. Es nutzt meinen neuen Lieblingstrick - geschlossene Familien über datakinds als „Wahl“ Mechanismus mit typischen Typklassen Mischen (Anmerkung: nicht einmal funktionale Abhängigkeiten verwenden, viel weniger überlappende Instanzen) den eigentlichen Code zu synthetisieren:

{-# LANGUAGE TypeFamilies, DataKinds, MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, FlexibleContexts #-} 

import Data.List 
import Data.Text (unpack, pack, Text) 
import Data.Proxy 

data ToTextMethod = TTMChar | TTMString | TTMText | TTMShow 

type family ToTextHow a where 
    ToTextHow Char = TTMChar 
    ToTextHow String = TTMString 
    ToTextHow Text = TTMText 
    ToTextHow a = TTMShow 

class ToTextC a b where 
     toTextC :: a -> b -> Text 

instance Show a => ToTextC a (Proxy TTMShow) where 
     toTextC a _ = pack (show a) 

instance ToTextC Char (Proxy TTMChar) where 
     toTextC c _ = pack [c] 

instance ToTextC String (Proxy TTMString) where 
     toTextC s _ = pack s 

instance ToTextC Text (Proxy TTMText) where 
     toTextC t _ = t 

toText :: forall a. (Show a, ToTextC a (Proxy (ToTextHow a))) => a -> Text 
toText x = toTextC x (Proxy :: Proxy (ToTextHow a)) 

Die Namen könnten wahrscheinlich etwas Arbeit gebrauchen, und es könnte nett sein, die Argumente auf toTextC zu spiegeln, aber das funktioniert sogar in Ghc 7.8.3.

Answer 2

Folgende Empfehlungen von jozefg in den Kommentaren, löste ich dieses Problem mit einer überladenen Funktion mit Typ Unterschrift a -> Text. Halten Sie dies für ein paar Tage offen, um zu sehen, ob jemand einen besseren Vorschlag hat.

Dies ist mein ursprünglicher TH splice (ghci Ausgang):

> runQ [| pack . show $ 1 ::Int|] 
SigE (InfixE (Just (InfixE (Just (VarE Data.Text.pack)) (VarE GHC.Base..) 
(Just (VarE GHC.Show.show)))) (VarE GHC.Base.$) (Just (LitE (IntegerL 1)))) 
(ConT GHC.Types.Int) 

Int zu Text umgewandelt wird. Die Ausführung von pack . show auf String oder Text wird jedoch problematisch sein, da es eine weitere Schicht von doppelten Anführungszeichen hinzufügen wird (und macht sowieso keinen Sinn). So benötigen wir eine spezielle Handhabung für für Text, String und Char Typen. So Lösung ist eine Funktion toText :: a -> Text und verwenden Sie es in der codegen zu schreiben, wie unten:

> runQ [| toText $ 1 ::Int|] 
SigE (InfixE (Just (VarE ToText.toText)) (VarE GHC.Base.$) (Just (LitE (IntegerL 1)))) (ConT GHC.Types.Int) 

Nun wird die Code-Generierung von toText behandelt sich je nach Typ. Dies ist, wie ich es in ghc 7.10.3 schrieb - es dauert den Standardcode (von dem ersten Spleiß, wie oben dargestellt), und Überlastungen es für einige Arten - jetzt haben wir den richtigen Code in TH codegen Lage bei der Kompilierung:

{-# LANGUAGE FlexibleInstances #-} 
module ToText 
where 

import Data.List 
import Data.Text (unpack, pack, Text) 

class ToText a where 
    toText :: (Show a) => a -> Text 

instance {-# OVERLAPPING #-} ToText a where 
    toText = pack . show 

instance {-# OVERLAPPING #-} ToText Char where 
    toText c = pack [c] 

instance {-# OVERLAPPING #-} ToText String where 
    toText = pack 

instance {-# OVERLAPPING #-} ToText Text where 
    toText = id