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

Question

Я написал программу, которая посетила AST с Haskell-src-exts. Я пытаюсь преобразовать его, чтобы использовать GHC API. Первый использует 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

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

РЕДАКТИРОВАТЬ: Вот почему текущий код не работает:

λ> :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 параметризован на тип имен, используемых в дереве: анализатор выводит AST с RdrName имена, с которыми, кажется, вы работаете. Комментарий GHC и пикши имеют больше информации.

Возможно, вам повезет больше, если вы сообщите компилятору, что вы работаете с 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