Посещение GHC AST с SYB

Question

Я написал программу, которая посетила AST с помощью Haskell-src-exts. Я пытаюсь преобразовать его, чтобы использовать API GHC. Первый использует Uniplate, в то время как для последнего кажется, что, к сожалению, меня принуждает SYB (документация ужасно скудная).

Вот исходный код:

module Argon.Visitor (funcsCC) 
    where 

import Data.Data (Data) 
import Data.Generics.Uniplate.Data (childrenBi, universeBi) 
import Language.Haskell.Exts.Syntax 
import Argon.Types (ComplexityBlock(..)) 


-- | Compute cyclomatic complexity of every function binding in the given AST. 
funcsCC :: Data from => from -> [ComplexityBlock] 
funcsCC ast = map funCC [matches | FunBind matches <- universeBi ast] 

funCC :: [Match] -> ComplexityBlock 
funCC [] = CC (0, 0, "<unknown>", 0) 
funCC ms@(Match (SrcLoc _ l c) n _ _ _ _:_) = CC (l, c, name n, complexity ms) 
    where name (Ident s) = s 
      name (Symbol s) = s 

sumWith :: (a -> Int) -> [a] -> Int 
sumWith f = sum . map f 

complexity :: Data from => from -> Int 
complexity node = 1 + visitMatches node + visitExps node 

visitMatches :: Data from => from -> Int 
visitMatches = sumWith descend . childrenBi 
    where descend :: [Match] -> Int 
      descend x = length x - 1 + sumWith visitMatches x 

visitExps :: Data from => from -> Int 
visitExps = sumWith inspect . universeBi 
    where inspect e = visitExp e + visitOp e 

visitExp :: Exp -> Int 
visitExp (If {})  = 1 
visitExp (MultiIf alts) = length alts - 1 
visitExp (Case _ alts) = length alts - 1 
visitExp (LCase alts) = length alts - 1 
visitExp _ = 0 

visitOp :: Exp -> Int 
visitOp (InfixApp _ (QVarOp (UnQual (Symbol op))) _) = 
    case op of 
    "||" -> 1 
    "&&" -> 1 
    _ -> 0 
visitOp _ = 0 

мне нужно посетить функции привязки, спичку и выражение. Это то, что мне удалось написать (не работает):

import Data.Generics 
import qualified GHC 
import Outputable -- from the GHC package 

funcs :: (Data id, Typeable id, Outputable id, Data from, Typeable from) => from -> [GHC.HsBindLR id id] 
funcs ast = everything (++) (mkQ [] (\fun@(GHC.FunBind {}) -> [fun])) ast 

Он жалуется на то, что слишком много примеров для id, но я не знаю, что щеколда это. Соответствующий модуль GHC: http://haddock.stackage.org/lts-3.10/ghc-7.10.2/HsBinds.html

Я схожу с ума от этого. Цель состоит в том, чтобы посчитать сложность (как вы можете видеть в исходном коде). Я хотел бы переключиться на API GHC, потому что он использует тот же парсер, что и компилятор, поэтому он может анализировать каждый модуль, не беспокоясь о расширениях.

EDIT: Вот почему текущий код не работает:

λ> :m +Language.Haskell.GHC.ExactPrint.Parsers GHC Data.Generics Outputable 
λ> r <- Language.Haskell.GHC.ExactPrint.parseModule src/Argon/Visitor.hs 
λ> let ast = snd $ (\(Right t) -> t) r 
.> 
λ> :t ast 
ast :: Located (HsModule RdrName) 
λ> let funcs = everything (++) (mkQ [] (un@(FunBind _ _ _ _ _ _) -> [fun])) ast :: (Data id, Typeable id, Outputable id) => [HsBindLR id id] 
.> 
λ> length funcs 

<interactive>:12:8: 
    No instance for (Data id0) arising from a use of ‘funcs’ 
    The type variable ‘id0’ is ambiguous 
    Note: there are several potential instances: 
     instance Data aeson-0.8.0.2:Data.Aeson.Types.Internal.Value 
     -- Defined in ‘aeson-0.8.0.2:Data.Aeson.Types.Internal’ 
     instance Data attoparsec-0.12.1.6:Data.Attoparsec.Number.Number 
     -- Defined in ‘attoparsec-0.12.1.6:Data.Attoparsec.Number’ 
     instance Data a => Data (Data.Complex.Complex a) 
     -- Defined in ‘Data.Complex’ 
     ../..plus 367 others 
    In the first argument of ‘length’, namely ‘funcs’ 
    In the expression: length funcs 
    In an equation for ‘it’: it = length funcs 

Answer 1

GHC АСТ является параметрическим по типу имен, используемых в дереве: анализатор выдает AST с RdrName именами, которые его похоже, вы работаете. GHC Commentary и the Haddocks имеют дополнительную информацию.

Возможно, вам повезет больше, если вы сообщите компилятору, что работаете с HsBindLR RdrName RdrName.

Как это:

import Data.Generics 
import GHC 
import Outputable -- from the GHC package 

funcs :: (Data from, Typeable from) => from -> [GHC.HsBindLR RdrName RdrName] 
funcs ast = everything (++) (mkQ [] (\fun@(GHC.FunBind {}) -> [fun])) ast