Ticket #4491: Language-Haskell-TH-Quote.diff

File Language-Haskell-TH-Quote.diff, 1.6 KB (added by gmainland, 5 years ago)

patch to Language.Haskell.TH.Quote

  • Language/Haskell/TH/Quote.hs

    diff -rN -u old-template-haskell/Language/Haskell/TH/Quote.hs new-template-haskell/Language/Haskell/TH/Quote.hs
    old new  
    3636        where
    3737          constr :: Constr
    3838          constr = toConstr t
    39           constrName :: Constr -> String
    40           constrName k =
    41               case showConstr k of
    42                 "(:)"  -> ":"
    43                 name   -> name
     39
    4440          con :: k
    45           con = mkCon (mkName (constrName constr))
     41          con = mkCon (mkName' mod occ)
     42            where
     43              mod :: String
     44              mod = (tyconModule . dataTypeName . dataTypeOf) t
     45
     46              occ :: String
     47              occ = showConstr constr
     48
     49              mkName' :: String -> String -> Name
     50              mkName' "Prelude" "(:)" = Name (mkOccName ":") NameS
     51              mkName' "Prelude" "[]"  = Name (mkOccName "[]") NameS
     52              mkName' "Prelude" "()"  = Name (mkOccName "()") NameS
     53
     54              mkName' "Prelude" s@('(' : ',' : rest) = go rest
     55                where
     56                  go :: String -> Name
     57                  go (',' : rest) = go rest
     58                  go ")"          = Name (mkOccName s) NameS
     59                  go _            = Name (mkOccName occ) (NameQ (mkModName mod))
     60
     61              mkName' "GHC.Real" ":%" = mkNameG_d "base" "GHC.Real" ":%"
     62
     63              mkName' mod occ = Name (mkOccName occ) (NameQ (mkModName mod))
     64
    4665          conArgs :: [Q q]
    4766          conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t
    4867