haskellghcabstract-syntax-treescrap-your-boilerplate

Visiting GHC AST with SYB


I wrote a program that visited the AST with Haskell-src-exts. I'm trying to convert it to use the GHC API. The former uses Uniplate, while for the latter it seems that unfortunately I'm forced with SYB (the documentation is horribly scarce).

Here is the original code:

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

I need to visit function bindings, matches and expressions. This is what I managed to write (not working):

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

It complains that there are too many instances for id, but I don't know what the heck it is. The relevant GHC module is: http://haddock.stackage.org/lts-3.10/ghc-7.10.2/HsBinds.html

I'm getting insane from this. The goal is to count complexity (as you can see in the original code). I'd like to switch to the GHC API because it uses the same parser as the compiler, so it can parse every module without worrying about extensions.

EDIT: Here is why the current code does not work:

λ> :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

Solution

  • The GHC AST is parametrised on the type of names used in the tree: the parser outputs an AST with RdrName names which it seems you're working with. The GHC Commentary and the Haddocks have more information.

    You might have more luck if you tell the compiler that you are working with HsBindLR RdrName RdrName.

    Like this:

    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