Haskell-src-exts で AST を訪問するプログラムを書きました。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モジュールは次のとおりです。
私はこれから気が狂います。目標は、複雑さを数えることです (元のコードでわかるように)。GHC API はコンパイラと同じパーサーを使用しているため、拡張子を気にせずにすべてのモジュールを解析できるため、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